mod_realinput_wrfarw.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
#include "scalelib.h"
module mod_realinput_wrfarw
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_io
  use scale_tracer
  use scale_cpl_sfc_index

  use scale_prc, only: &
     myrank => prc_myrank,  &
     prc_abort
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: parentatmossetupwrfarw
  public :: parentatmosopenwrfarw
  public :: parentatmosinputwrfarw
  public :: parentlandsetupwrfarw
  public :: parentlandinputwrfarw
  public :: parentoceansetupwrfarw
  public :: parentoceanopenwrfarw
  public :: parentoceaninputwrfarw

  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  ! Defined parameters in WRF

  real(RP), parameter :: t0  = 300.0_rp
  real(RP), parameter :: p0  = 1000.0e+2_rp
  real(RP), parameter :: rd  = 287.04_rp
  real(RP), parameter :: cp  = 7.0_rp * rd / 2.0_rp
  real(RP), parameter :: rcp = rd / cp

  integer, parameter :: cosin = 1
  integer, parameter :: sine  = 2

  real(RP), allocatable :: read_xy (:,:)
  real(RP), allocatable :: read_xyz(:,:,:)
  real(RP), allocatable :: read_xyw(:,:,:)
  real(RP), allocatable :: read_xyl(:,:,:)

  real(RP), allocatable :: p_org   (:,:,:)
  real(RP), allocatable :: pb_org  (:,:,:)
  real(RP), allocatable :: ph_org  (:,:,:)
  real(RP), allocatable :: phb_org (:,:,:)

  logical, private :: wrfout = .false. ! file type switch (wrfout or wrfrst)

  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine parentatmossetupwrfarw( &
      dims,    &
      timelen, &
      basename_org )
    use scale_file, only: &
       file_open, &
       file_get_dimlength
    implicit none

    integer,          intent(out) :: dims(6)
    integer,          intent(out) :: timelen
    character(len=*), intent(in)  :: basename_org

    logical :: WRF_FILE_TYPE = .false.   ! wrf filetype: T=wrfout, F=wrfrst

    namelist / param_mkinit_real_wrfarw / &
         wrf_file_type

    integer :: fid
    integer :: ierr
    logical :: error
    !---------------------------------------------------------------------------

    log_newline
    log_info("ParentAtmosSetupWRFARW",*) 'Setup'

    !--- read namelist
    rewind(io_fid_conf)
    read(io_fid_conf,nml=param_mkinit_real_wrfarw,iostat=ierr)
    if( ierr > 0 ) then
       log_error("ParentAtmosSetupWRFARW",*) 'Not appropriate names in namelist PARAM_MKINIT_REAL_WRFARW. Check!'
       call prc_abort
    endif
    log_nml(param_mkinit_real_wrfarw)

    call file_open( basename_org, fid, rankid=myrank, single=.true., postfix="" )

    call file_get_dimlength( fid, "bottom_top",       dims(1) )
    call file_get_dimlength( fid, "west_east",        dims(2) )
    call file_get_dimlength( fid, "south_north",      dims(3) )
    call file_get_dimlength( fid, "bottom_top_stag",  dims(4) )
    call file_get_dimlength( fid, "west_east_stag",   dims(5) )
    call file_get_dimlength( fid, "south_north_stag", dims(6) )

    call file_get_dimlength( fid, "Time", timelen, error=error )
    if ( error ) call file_get_dimlength( fid, "time", timelen, error=error)
    if ( error ) timelen = 0

    if ( wrf_file_type ) then
       wrfout = .true.
       log_info("ParentAtmosSetupWRFARW",*) 'WRF-ARW FILE-TYPE: WRF History Output'
    else
       wrfout = .false.
       log_info("ParentAtmosSetupWRFARW",*) 'WRF-ARW FILE-TYPE: WRF Restart'
    endif


    allocate( read_xy(dims(2),dims(3)) )
    allocate( read_xyz(dims(2),dims(3),dims(1)) )
    allocate( read_xyw(dims(2),dims(3),dims(4)) )

    allocate( p_org(dims(1),dims(2),dims(3)) )
    allocate( pb_org(dims(1),dims(2),dims(3)) )
    allocate( ph_org(dims(4),dims(2),dims(3)) )
    allocate( phb_org(dims(4),dims(2),dims(3)) )

    return
  end subroutine parentatmossetupwrfarw

  !-----------------------------------------------------------------------------
  subroutine parentatmosopenwrfarw
    implicit none

    return
  end subroutine parentatmosopenwrfarw

  !-----------------------------------------------------------------------------
  subroutine parentatmosinputwrfarw( &
       velz_org,      &
       llvelx_org,    &
       llvely_org,    &
       pres_org,      &
       temp_org,      &
       qv_org,        &
       qhyd_org,      &
       qnum_org,      &
       lon_org,       &
       lat_org,       &
       cz_org,        &
       basename,      &
       dims,          &
       it             ) ! (in)
    use scale_const, only: &
       d2r => const_d2r, &
       laps => const_laps, &
       rdry => const_rdry, &
       grav => const_grav
    use scale_file, only: &
       file_open, &
       file_read
    use scale_atmos_hydrometeor, only: &
       n_hyd, &
       i_hc, &
       i_hr, &
       i_hi, &
       i_hs, &
       i_hg
    implicit none

    real(RP),         intent(out) :: velz_org(:,:,:)
    real(RP),         intent(out) :: llvelx_org(:,:,:)
    real(RP),         intent(out) :: llvely_org(:,:,:)
    real(RP),         intent(out) :: pres_org(:,:,:)
    real(RP),         intent(out) :: temp_org(:,:,:)
    real(RP),         intent(out) :: qv_org(:,:,:)
    real(RP),         intent(out) :: qhyd_org(:,:,:,:)
    real(RP),         intent(out) :: qnum_org(:,:,:,:)
    real(RP),         intent(out) :: lon_org(:,:)
    real(RP),         intent(out) :: lat_org(:,:)
    real(RP),         intent(out) :: cz_org(:,:,:)
    character(len=*), intent(in)  :: basename
    integer,          intent(in)  :: dims(6)
    integer,          intent(in)  :: it

    ! k, i, j
    real(RP) :: velx_org(dims(1)+2,dims(2),dims(3))
    real(RP) :: vely_org(dims(1)+2,dims(2),dims(3))
    real(RP) :: pott_org(dims(1)+2,dims(2),dims(3))
    real(RP) :: topo_org(          dims(2),dims(3))
    real(RP) :: geof_org(dims(4)  ,dims(2),dims(3))


    ! i, j, k
    real(RP) :: velzs_org(dims(2),dims(3),dims(4))
    real(RP) :: velxs_org(dims(5),dims(3),dims(1))
    real(RP) :: velys_org(dims(2),dims(6),dims(1))

    real(RP) :: dens
    real(RP) :: qtot

    integer :: k, i, j, iq

    character(len=H_MID) :: varname_T
    character(len=H_MID) :: varname_W
    character(len=H_MID) :: varname_U
    character(len=H_MID) :: varname_V

    integer :: fid
    !---------------------------------------------------------------------------

    if ( wrfout ) then
       varname_t = "T"
       varname_w = "W"
       varname_u = "U"
       varname_v = "V"
    else
       varname_t = "T_1"
       varname_w = "W_1"
       varname_u = "U_1"
       varname_v = "V_1"
    endif


    call file_open( basename, fid, rankid=myrank, single=.true., postfix="" )

    call file_read( fid, "XLAT", lat_org(:,:), step=it )
    lat_org(:,:) = lat_org(:,:) * d2r

    call file_read( fid, "XLONG", lon_org(:,:), step=it )
    lon_org(:,:) = lon_org(:,:) * d2r

    call file_read( fid, "HGT", topo_org(:,:), step=it )

    call file_read( fid, "PH", read_xyw(:,:,:), step=it )
    do j = 1, dims(3)
    do i = 1, dims(2)
    do k = 1, dims(4)
       ph_org(k,i,j) = read_xyw(i,j,k)
    end do
    end do
    end do

    call file_read( fid, "PHB", read_xyw(:,:,:), step=it )
    do j = 1, dims(3)
    do i = 1, dims(2)
    do k = 1, dims(4)
       phb_org(k,i,j) = read_xyw(i,j,k)
    end do
    end do
    end do

    call file_read( fid, "P", read_xyz(:,:,:), step=it )
    do j = 1, dims(3)
    do i = 1, dims(2)
    do k = 1, dims(1)
       p_org(k,i,j) = read_xyz(i,j,k)
    end do
    end do
    end do

    call file_read( fid, "PB", read_xyz(:,:,:), step=it )
    do j = 1, dims(3)
    do i = 1, dims(2)
    do k = 1, dims(1)
       pb_org(k,i,j) = read_xyz(i,j,k)
    end do
    end do
    end do

    call file_read( fid, varname_w, velzs_org(:,:,:), step=it )

    call file_read( fid, varname_u, velxs_org(:,:,:), step=it )

    call file_read( fid, varname_v, velys_org(:,:,:), step=it )


    ! from half level to full level
    do j = 1, dims(3)
    do i = 1, dims(2)
       do k = 1, dims(1)
          velz_org(k+2,i,j) = ( velzs_org(i,j,k) + velzs_org(i,j,k+1) ) * 0.5_rp
          velx_org(k+2,i,j) = ( velxs_org(i,j,k) + velxs_org(i+1,j,k) ) * 0.5_rp
          vely_org(k+2,i,j) = ( velys_org(i,j,k) + velys_org(i,j+1,k) ) * 0.5_rp
       end do
       velz_org(1:2,i,j) = 0.0_rp
       velx_org(1:2,i,j) = 0.0_rp
       vely_org(1:2,i,j) = 0.0_rp
    end do
    end do

    call wrf_arwpost_calc_uvmet( llvelx_org, llvely_org, & ! (out)
                                 velx_org, vely_org,     & ! (in)
                                 lon_org, lat_org,       & ! (in)
                                 basename,               & ! (in)
                                 dims(1)+2, dims(2), dims(3) ) ! (in)

    qhyd_org(:,:,:,:) = 0.0_rp

    call file_read( fid, "Q2", read_xy(:,:), step=it )
    do j = 1, dims(3)
    do i = 1, dims(2)
       qv_org(1,i,j) = read_xy(i,j)
       qv_org(2,i,j) = read_xy(i,j)
    end do
    end do

    call file_read( fid, "QVAPOR", read_xyz(:,:,:), step=it )
    do j = 1, dims(3)
    do i = 1, dims(2)
    do k = 1, dims(1)
       qv_org(k+2,i,j) = read_xyz(i,j,k)
    end do
    end do
    end do


    call file_read( fid, "QCLOUD", read_xyz(:,:,:), step=it, allow_missing=.true. )
    do j = 1, dims(3)
    do i = 1, dims(2)
    do k = 1, dims(1)
       qhyd_org(k+2,i,j,i_hc) = read_xyz(i,j,k)
    end do
    end do
    end do

    call file_read( fid, "QRAIN", read_xyz(:,:,:), step=it, allow_missing=.true. )
    do j = 1, dims(3)
    do i = 1, dims(2)
    do k = 1, dims(1)
       qhyd_org(k+2,i,j,i_hc) = read_xyz(i,j,k)
    end do
    end do
    end do

    call file_read( fid, "QICE", read_xyz(:,:,:), step=it, allow_missing=.true. )
    do j = 1, dims(3)
    do i = 1, dims(2)
    do k = 1, dims(1)
       qhyd_org(k+2,i,j,i_hi) = read_xyz(i,j,k)
    end do
    end do
    end do

    call file_read( fid, "QSNOW", read_xyz(:,:,:), step=it, allow_missing=.true. )
    do j = 1, dims(3)
    do i = 1, dims(2)
    do k = 1, dims(1)
       qhyd_org(k+2,i,j,i_hs) = read_xyz(i,j,k)
    end do
    end do
    end do

    call file_read( fid, "QGRAUP", read_xyz(:,:,:), step=it, allow_missing=.true. )
    do j = 1, dims(3)
    do i = 1, dims(2)
    do k = 1, dims(1)
       qhyd_org(k+2,i,j,i_hg) = read_xyz(i,j,k)
    end do
    end do
    end do


    ! convert mixing ratio to specific ratio
    do j = 1, dims(3)
    do i = 1, dims(2)
    do k = 1, dims(1)+2
       qtot = qv_org(k,i,j)
       do iq = 1, n_hyd
          qtot = qtot + qhyd_org(k,i,j,iq)
       end do
       qv_org(k,i,j) = qv_org(k,i,j) / ( 1.0_rp + qtot )
       do iq = 1, n_hyd
          qhyd_org(k,i,j,iq) = qhyd_org(k,i,j,iq) / ( 1.0_rp + qtot )
       end do
    end do
    end do
    end do

    call file_read( fid, "NC", read_xyz(:,:,:), step=it, allow_missing=.true. )
    do j = 1, dims(3)
    do i = 1, dims(2)
    do k = 1, dims(1)
       qnum_org(k+2,i,j,i_hc) = read_xyz(i,j,k)
    end do
    end do
    end do

    call file_read( fid, "NR", read_xyz(:,:,:), step=it, allow_missing=.true. )
    do j = 1, dims(3)
    do i = 1, dims(2)
    do k = 1, dims(1)
       qnum_org(k+2,i,j,i_hr) = read_xyz(i,j,k)
    end do
    end do
    end do

    call file_read( fid, "NI", read_xyz(:,:,:), step=it, allow_missing=.true. )
    do j = 1, dims(3)
    do i = 1, dims(2)
    do k = 1, dims(1)
       qnum_org(k+2,i,j,i_hi) = read_xyz(i,j,k)
    end do
    end do
    end do

    call file_read( fid, "NS", read_xyz(:,:,:), step=it, allow_missing=.true. )
    do j = 1, dims(3)
    do i = 1, dims(2)
    do k = 1, dims(1)
       qnum_org(k+2,i,j,i_hs) = read_xyz(i,j,k)
    end do
    end do
    end do

    call file_read( fid, "NG", read_xyz(:,:,:), step=it, allow_missing=.true. )
    do j = 1, dims(3)
    do i = 1, dims(2)
    do k = 1, dims(1)
       qnum_org(k+2,i,j,i_hg) = read_xyz(i,j,k)
    end do
    end do
    end do

    do iq = 1, n_hyd
    do j = 1, dims(3)
    do i = 1, dims(2)
    do k = 1, dims(1)+2
       qhyd_org(k,i,j,iq) = max( qhyd_org(k,i,j,iq), 0.0_rp )
       qnum_org(k,i,j,iq) = max( qnum_org(k,i,j,iq), 0.0_rp )
    end do
    end do
    end do
    end do


    call file_read( fid, varname_t, read_xyz(:,:,:), step=it, allow_missing=.true. )
    do j = 1, dims(3)
    do i = 1, dims(2)
    do k = 1, dims(1)
       pott_org(k+2,i,j) = read_xyz(i,j,k) + t0
    end do
    end do
    end do
    call file_read( fid, "T2", read_xy(:,:), step=it, allow_missing=.true. )
    do j = 1, dims(3)
    do i = 1, dims(2)
       temp_org(2,i,j) = read_xy(i,j)
    end do
    end do

    call file_read( fid, "PSFC", read_xy(:,:), step=it, allow_missing=.true. )
    do j = 1, dims(3)
    do i = 1, dims(2)
       pres_org(2,i,j) = read_xy(i,j)
    end do
    end do

    do j = 1, dims(3)
    do i = 1, dims(2)
       do k = 3, dims(1)+2
          pres_org(k,i,j) = p_org(k-2,i,j) + pb_org(k-2,i,j)
          temp_org(k,i,j) = pott_org(k,i,j) * ( pres_org(k,i,j) / p0 )**rcp
       end do
       pott_org(2,i,j) = temp_org(2,i,j) * ( p0/pres_org(2,i,j) )**rcp
       temp_org(1,i,j) = temp_org(2,i,j) + laps * topo_org(i,j)
       dens = pres_org(2,i,j) / ( rdry * temp_org(2,i,j) )
       pres_org(1,i,j) = ( pres_org(2,i,j) + grav * dens * cz_org(2,i,j) * 0.5_rp ) &
                       / ( rdry * temp_org(1,i,j) - grav * cz_org(2,i,j) * 0.5_rp ) &
                       * rdry * temp_org(1,i,j)
    end do
    end do

    do j = 1, dims(3)
    do i = 1, dims(2)
       ! convert to geopotential height to use as real height in WRF
       do k = 1, dims(4)
          geof_org(k,i,j) = ( ph_org(k,i,j) + phb_org(k,i,j) ) / grav
       end do
       ! make half level of geopotential height from face level
       do k = 1, dims(1)
          cz_org(k+2,i,j) = ( geof_org(k,i,j) + geof_org(k+1,i,j) ) * 0.5_rp
       end do
       cz_org(2,i,j) = topo_org(i,j)
       cz_org(1,i,j) = 0.0_rp
    end do
    end do


#ifdef DEBUG
     !k=1 ; i=int(dims(2)/2) ; j=int(dims(3)/2)
     k=2 ; i=3 ; j=3
     log_info("ParentAtmosInputWRFARW",*) "read 3D wrf data",i,j,k
     log_info("ParentAtmosInputWRFARW",*) "lon_org    ",lon_org(i,j)/d2r
     log_info("ParentAtmosInputWRFARW",*) "lat_org    ",lat_org(i,j)/d2r
     log_info("ParentAtmosInputWRFARW",*) "cz_org     ",cz_org(k,i,j)
     log_info("ParentAtmosInputWRFARW",*) "pres_org   ",pres_org(k,i,j)
     log_info("ParentAtmosInputWRFARW",*) "velx_org   ",llvelx_org(k,i,j)
     log_info("ParentAtmosInputWRFARW",*) "vely_org   ",llvely_org(k,i,j)
     log_info("ParentAtmosInputWRFARW",*) "velz_org   ",velz_org(k,i,j)
     log_info("ParentAtmosInputWRFARW",*) "temp_org   ",temp_org(k,i,j)
     log_info("ParentAtmosInputWRFARW",*) "qv_org     ",qv_org(k,i,j)
     k=3 ; i=3 ; j=3 ; iq = 1
     log_info("ParentAtmosInputWRFARW",*) "read 3D wrf data",i,j,k
     log_info("ParentAtmosInputWRFARW",*) "lon_org    ",lon_org(i,j)/d2r
     log_info("ParentAtmosInputWRFARW",*) "lat_org    ",lat_org(i,j)/d2r
     log_info("ParentAtmosInputWRFARW",*) "cz_org     ",cz_org(k,i,j)
     log_info("ParentAtmosInputWRFARW",*) "pres_org   ",pres_org(k,i,j)
     log_info("ParentAtmosInputWRFARW",*) "velx_org   ",llvelx_org(k,i,j)
     log_info("ParentAtmosInputWRFARW",*) "vely_org   ",llvely_org(k,i,j)
     log_info("ParentAtmosInputWRFARW",*) "velz_org   ",velz_org(k,i,j)
     log_info("ParentAtmosInputWRFARW",*) "temp_org   ",temp_org(k,i,j)
     log_info("ParentAtmosInputWRFARW",*) "qv_org     ",qv_org(k,i,j)
#endif

    return
  end subroutine parentatmosinputwrfarw

  !-----------------------------------------------------------------------------
  subroutine parentlandsetupwrfarw( &
       ldims,    &
       basename_land )
    use scale_file, only: &
       file_open, &
       file_get_dimlength
    implicit none

    integer,          intent(out) :: ldims(3)
    character(len=*), intent(in)  :: basename_land

    logical :: WRF_FILE_TYPE = .false.   ! wrf filetype: T=wrfout, F=wrfrst

    namelist / param_mkinit_real_wrfarw / &
         wrf_file_type

    integer :: fid
    integer :: ierr
    !---------------------------------------------------------------------------

    log_info("ParentLandSetupWRFARW",*) 'Real Case/Atmos Input File Type: WRF-ARW'

    !--- read namelist
    rewind(io_fid_conf)
    read(io_fid_conf,nml=param_mkinit_real_wrfarw,iostat=ierr)
    if( ierr > 0 ) then
       log_error("ParentLandSetupWRFARW",*) 'Not appropriate names in namelist PARAM_MKINIT_REAL_WRFARW. Check!'
       call prc_abort
    endif
    log_nml(param_mkinit_real_wrfarw)


    call file_open( basename_land, fid, rankid=myrank, single=.true., postfix="" )

    call file_get_dimlength( fid, "soil_layers_stag", ldims(1) )
    call file_get_dimlength( fid, "west_east",        ldims(2) )
    call file_get_dimlength( fid, "south_north",      ldims(3) )

    if ( wrf_file_type ) then
       wrfout = .true.
       log_info("ParentLandSetupWRFARW",*) 'WRF-ARW FILE-TYPE: WRF History Output'
    else
       wrfout = .false.
       log_info("ParentLandSetupWRFARW",*) 'WRF-ARW FILE-TYPE: WRF Restart'
    endif


    if ( .not. allocated(read_xy) ) then
       allocate( read_xy(ldims(2),ldims(3)) )
    end if

    allocate( read_xyl(ldims(2),ldims(3),ldims(1)) )

    return
  end subroutine parentlandsetupwrfarw

  !-----------------------------------------------------------------------------
  subroutine parentlandinputwrfarw( &
      tg_org,             &
      sh2o_org,           &
      lst_org,            &
      ust_org,            &
      albg_org,           &
      topo_org,           &
      lmask_org,          &
      llon_org,           &
      llat_org,           &
      lz_org,             &
      basename,           &
      ldims,              &
      use_file_landwater, &
      it                  )
    use scale_const, only: &
       d2r => const_d2r, &
       undef => const_undef
    use scale_file, only: &
       file_open, &
       file_read
    implicit none
    real(RP),         intent(out)  :: tg_org(:,:,:)
    real(RP),         intent(out)  :: sh2o_org(:,:,:)
    real(RP),         intent(out)  :: lst_org(:,:)
    real(RP),         intent(out)  :: ust_org(:,:)
    real(RP),         intent(out)  :: albg_org(:,:,:,:)
    real(RP),         intent(out)  :: topo_org(:,:)
    real(RP),         intent(out)  :: lmask_org(:,:)
    real(RP),         intent(out)  :: llon_org(:,:)
    real(RP),         intent(out)  :: llat_org(:,:)
    real(RP),         intent(out)  :: lz_org(:)
    character(len=*), intent( in)  :: basename
    integer,          intent( in)  :: ldims(3)
    logical,          intent( in)  :: use_file_landwater   ! use land water data from files
    integer,          intent( in)  :: it

    integer :: fid
    integer :: k, i, j
    !---------------------------------------------------------------------------

    call file_open( basename, fid, rankid=myrank, single=.true., postfix="" )

    call file_read( fid, "XLAT", llat_org(:,:), step=it )
    llat_org(:,:) = llat_org(:,:) * d2r

    call file_read( fid, "XLONG", llon_org(:,:), step=it )
    llon_org(:,:) = llon_org(:,:) * d2r

    call file_read( fid, "HGT", topo_org(:,:), step=it )


    ! depth
    call file_read( fid, "ZS", lz_org(:), step=it )

    ! land mask (1:land, 0:water)
    call file_read( fid, "LANDMASK", lmask_org(:,:), step=it )

    ! soil temperature [K]
    call file_read( fid, "TSLB", read_xyl(:,:,:), step=it )
    do j = 1, ldims(3)
    do i = 1, ldims(2)
    do k = 1, ldims(1)
       tg_org(k,i,j) = read_xyl(i,j,k)
    end do
    end do
    end do

    ! soil liquid water [m3 m-3] (no wrfout-default)
    if( use_file_landwater ) then
       call file_read( fid, "SH2O", read_xyl(:,:,:), step=it, allow_missing=.true., missing_value=undef )
       do j = 1, ldims(3)
       do i = 1, ldims(2)
       do k = 1, ldims(1)
          sh2o_org(k,i,j) = read_xyl(i,j,k)
       end do
       end do
       end do
    endif

!    ! surface runoff [mm]
!    call FILE_read( fid, "SFROFF", org_3D(:,:), step=it )
!    do j = 1, ldims(3)
!    do i = 1, ldims(2)
!       org_3D(k,i,j) = org_3D(i,j,k) * 1000.0_RP * dwatr
!    end do
!    end do


    ! SURFACE SKIN TEMPERATURE [K]
    call file_read( fid, "TSK", lst_org(:,:), step=it )

    ust_org(:,:) = lst_org(:,:)

    ! ALBEDO [-]
    call file_read( fid, "ALBEDO", albg_org(:,:,i_r_direct ,i_r_vis), step=it )
    albg_org(:,:,i_r_direct ,i_r_nir) = albg_org(:,:,i_r_direct ,i_r_vis)
    albg_org(:,:,i_r_diffuse,i_r_nir) = albg_org(:,:,i_r_direct ,i_r_vis)
    albg_org(:,:,i_r_diffuse,i_r_vis) = albg_org(:,:,i_r_direct ,i_r_vis)

    ! SURFACE EMISSIVITY [-]
    call file_read( fid, "EMISS", read_xy(:,:), step=it )
    do j = 1, ldims(3)
    do i = 1, ldims(2)
       albg_org(i,j,i_r_diffuse,i_r_ir) = 1.0_rp - read_xy(i,j)
    end do
    end do
    albg_org(:,:,i_r_direct,i_r_ir) = albg_org(:,:,i_r_diffuse,i_r_ir)

!    ! SNOW WATER EQUIVALENT [kg m-2] (no wrfout-default)
!    call FILE_read( fid, "SNOW", snowq_org(:,:), step=it, allow_missing=.true., missing_value=UNDEF )

!    ! AVERAGE SNOW TEMPERATURE [C] (no wrfout-default)
!    call FILE_read( fid, "TSNAV", snowt_org(:,:), step=it, allow_missing=.true., missing_value=UNDEF )
!    do j = 1, ldims(3)
!    do i = 1, ldims(2)
!       if ( snowt_org(k,i,j) /= UNDEF ) snowt_org(k,i,j) = snowt_org(i,j,k) + TEM00
!    end do
!    end do

    return
  end subroutine parentlandinputwrfarw

  !-----------------------------------------------------------------------------
  subroutine parentoceansetupwrfarw( &
       odims,    &
       timelen, &
       basename_org )
    use scale_file, only: &
       file_open, &
       file_get_dimlength
    implicit none

    integer,          intent(out) :: odims(2)
    integer,          intent(out) :: timelen
    character(len=*), intent(in)  :: basename_org

    logical :: WRF_FILE_TYPE = .false.   ! wrf filetype: T=wrfout, F=wrfrst

    namelist / param_mkinit_real_wrfarw / &
         wrf_file_type

    integer :: fid
    integer :: ierr
    logical :: error
    !---------------------------------------------------------------------------

    log_info("ParentOceanSetupWRFARW",*) 'Real Case/Ocean Input File Type: WRF-ARW'

    !--- read namelist
    rewind(io_fid_conf)
    read(io_fid_conf,nml=param_mkinit_real_wrfarw,iostat=ierr)
    if( ierr > 0 ) then
       log_error("ParentOceanSetupWRFARW",*) 'Not appropriate names in namelist PARAM_MKINIT_REAL_WRFARW. Check!'
       call prc_abort
    endif
    log_nml(param_mkinit_real_wrfarw)


    call file_open( basename_org, fid, rankid=myrank, single=.true., postfix="" )

    call file_get_dimlength(fid, "west_east",   odims(1) )
    call file_get_dimlength(fid, "south_north", odims(2) )

    call file_get_dimlength(fid, "Time", timelen, error=error )
    if ( error ) call file_get_dimlength(fid, "time",  timelen, error=error)
    if ( error ) timelen = 0

    if ( wrf_file_type ) then
       wrfout = .true.
       log_info("ParentOceanSetupWRFARW",*) 'WRF-ARW FILE-TYPE: WRF History Output'
    else
       wrfout = .false.
       log_info("ParentOceanSetupWRFARW",*) 'WRF-ARW FILE-TYPE: WRF Restart'
    endif


    if ( .not. allocated(read_xy) ) then
       allocate( read_xy(odims(1),odims(2)) )
    end if

    return
  end subroutine parentoceansetupwrfarw

  !-----------------------------------------------------------------------------
  subroutine parentoceanopenwrfarw
    implicit none

    return
  end subroutine parentoceanopenwrfarw

  !-----------------------------------------------------------------------------
  subroutine parentoceaninputwrfarw( &
      tw_org,             &
      sst_org,            &
      albw_org,           &
      z0w_org,            &
      omask_org,          &
      olon_org,           &
      olat_org,           &
      basename,           &
      odims,              &
      it                  )
    use scale_const, only: &
       d2r => const_d2r, &
       undef => const_undef
    use scale_file, only: &
       file_open, &
       file_read
    implicit none
    real(RP),         intent(out)  :: tw_org(:,:)
    real(RP),         intent(out)  :: sst_org(:,:)
    real(RP),         intent(out)  :: albw_org(:,:,:,:)
    real(RP),         intent(out)  :: z0w_org(:,:)
    real(RP),         intent(out)  :: omask_org(:,:)
    real(RP),         intent(out)  :: olon_org(:,:)
    real(RP),         intent(out)  :: olat_org(:,:)
    character(len=*), intent( in)  :: basename
    integer,          intent( in)  :: odims(2)
    integer,          intent( in)  :: it

    integer :: fid
    integer :: i, j
    !---------------------------------------------------------------------------

    call file_open( basename, fid, rankid=myrank, single=.true., postfix="" )

    call file_read( fid, "XLAT", olat_org(:,:), step=it )
    olat_org(:,:) = olat_org(:,:) * d2r

    call file_read( fid, "XLONG", olon_org(:,:), step=it )
    olon_org(:,:) = olon_org(:,:) * d2r


    ! land mask (1:land, 0:water)
    call file_read( fid, "LANDMASK", omask_org(:,:), step=it )

    ! SEA SURFACE TEMPERATURE [K]
    call file_read( fid, "SST", sst_org(:,:), step=it )

    tw_org(:,:) = sst_org(:,:)

    ! ALBEDO [-]
    call file_read( fid, "ALBEDO", albw_org(:,:,i_r_direct ,i_r_vis), step=it )
    albw_org(:,:,i_r_direct ,i_r_nir) = albw_org(:,:,i_r_direct ,i_r_vis)
    albw_org(:,:,i_r_diffuse,i_r_nir) = albw_org(:,:,i_r_direct ,i_r_vis)
    albw_org(:,:,i_r_diffuse,i_r_vis) = albw_org(:,:,i_r_direct ,i_r_vis)

    ! SURFACE EMISSIVITY [-]
    call file_read( fid, "EMISS", read_xy(:,:), step=it )
    do j = 1, odims(2)
    do i = 1, odims(1)
       albw_org(i,j,i_r_diffuse,i_r_ir) = 1.0_rp - read_xy(i,j)
    enddo
    enddo
    albw_org(:,:,i_r_direct,i_r_ir) = albw_org(:,:,i_r_diffuse,i_r_ir)

    ! TIME-VARYING ROUGHNESS LENGTH [m] (no wrfout-default)
    call file_read( fid, "ZNT", z0w_org(:,:), step=it, allow_missing=.true., missing_value=undef )


    return
  end subroutine parentoceaninputwrfarw

  !-----------------------------------------------------------------------------
  !-----------------------------------------------------------------------------
  subroutine wrf_arwpost_calc_uvmet( &
      u_latlon,   & ! (out)
      v_latlon,   & ! (out)
      u_on_map,   & ! (in)
      v_on_map,   & ! (in)
      xlon,       & ! (in)
      xlat,       & ! (in)
      basename ,  & ! (in)
      k1, i1, j1  ) ! (in)
    use scale_const, only: &
       d2r => const_d2r, &
       pi => const_pi
    use scale_file, only: &
       file_open, &
       file_get_attribute
    implicit none
    real(RP), intent(out) :: u_latlon(:,:,:)
    real(RP), intent(out) :: v_latlon(:,:,:)
    real(RP), intent(in ) :: u_on_map(:,:,:)
    real(RP), intent(in ) :: v_on_map(:,:,:)
    real(RP), intent(in ) :: xlon(:,:)
    real(RP), intent(in ) :: xlat(:,:)
    integer , intent(in ) :: K1, I1, J1

    character(len=*), intent( in) :: basename

    integer :: fid

    real(RP) :: truelat1, truelat2
    real(RP) :: stand_lon
    real(RP) :: diff
    real(RP) :: alpha
    real(RP) :: sine(i1,j1)
    real(RP) :: cose(i1,j1)
    real(RP) :: cone
    integer  :: map_proj

    real(RP) :: dum_r(1)
    integer  :: dum_i(1)


    integer  :: k, i, j
    !---------------------------------------------------------------------------

    call file_open( basename, fid, rankid=myrank, single=.true., postfix="" )

    call file_get_attribute( fid, "global", "MAP_PROJ", dum_i(:) )
    map_proj = dum_i(1)

    call file_get_attribute( fid, "global", "TRUELAT1", dum_r(:) )
    truelat1 = dum_r(1) * d2r
    call file_get_attribute( fid, "global", "TRUELAT2", dum_r(:) )
    truelat2 = dum_r(1) * d2r
    call file_get_attribute( fid, "global", "STAND_LON", dum_r(:) )
    stand_lon = dum_r(1) * d2r

    ! No need to rotate
    if ( map_proj .ge. 3 ) then
       u_latlon(:,:,:) = u_on_map(:,:,:)
       v_latlon(:,:,:) = v_on_map(:,:,:)

       return
    endif

    ! Lambert Conformal mapping
    cone = 1.0_rp         !  PS
    if ( map_proj .eq. 1 ) then
       if ( abs(truelat1-truelat2) .gt. 0.1_rp*d2r ) then
          cone = ( log(cos(truelat1)) -                 &
                   log(cos(truelat2)) )  /              &
                 ( log(tan((pi*0.5_rp-abs(truelat1))*0.5_rp )) - &
                   log(tan((pi*0.5_rp-abs(truelat2))*0.5_rp )) )
       else
          cone = sin( abs(truelat1) )
       endif
    endif

    do j = 1, j1
    do i = 1, i1
       diff = xlon(i,j) - stand_lon
       if ( diff .gt. pi ) then
          diff = diff - pi*2.0_rp
       endif
       if ( diff .lt. -pi ) then
          diff = diff + pi*2.0_rp
       endif
       alpha = diff * cone * sign(1.0_rp, xlat(i,j))
       sine(i,j) = sin( alpha )
       cose(i,j) = cos( alpha )
    enddo
    enddo

    do j = 1, j1
    do i = 1, i1
    do k = 1, k1
       u_latlon(k,i,j) = v_on_map(k,i,j)*sine(i,j) + u_on_map(k,i,j)*cose(i,j)
       v_latlon(k,i,j) = v_on_map(k,i,j)*cose(i,j) - u_on_map(k,i,j)*sine(i,j)
    enddo
    enddo
    enddo

    return
  end subroutine wrf_arwpost_calc_uvmet

end module mod_realinput_wrfarw