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,      &
       sfc_diagnoses, &
       dims,          &
       it             )
    use scale_const, only: &
       undef => const_undef, &
       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
    logical,          intent(in)  :: sfc_diagnoses
    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) :: dz
    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 )
    !$omp parallel do
    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 )
    !$omp parallel do
    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 )
    !$omp parallel do
    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 )
    !$omp parallel do
    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
    !$omp parallel do
    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)
 
    !$omp parallel do collapse(4)
    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) = 0.0_rp
    end do
    end do
    end do
    end do
 
    call file_read( fid, "QVAPOR", read_xyz(:,:,:), step=it )
    !$omp parallel do
    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
 
    if ( sfc_diagnoses ) then
       call file_read( fid, "Q2", read_xy(:,:), step=it )
       !$omp parallel do
       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
    else
       !$omp parallel do
       do j = 1, dims(3)
       do i = 1, dims(2)
          qv_org(1:2,i,j) = undef
       end do
       end do
    end if
 
 
    call file_read( fid, "QCLOUD", read_xyz(:,:,:), step=it, allow_missing=.true. )
    !$omp parallel do
    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. )
    !$omp parallel do
    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. )
    !$omp parallel do
    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. )
    !$omp parallel do
    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. )
    !$omp parallel do
    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
    !$omp parallel do &
    !$omp private(qtot)
    do j = 1, dims(3)
    do i = 1, dims(2)
    do k = 1, dims(1)+2
       if ( k<3 .and. .not. sfc_diagnoses ) then
          qv_org(k,i,j) = undef
          do iq = 1, n_hyd
             qhyd_org(k,i,j,iq) = undef
          end do
       else
          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 if
    end do
    end do
    end do
 
    call file_read( fid, "NC", read_xyz(:,:,:), step=it, allow_missing=.true. )
    !$omp parallel do
    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. )
    !$omp parallel do
    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. )
    !$omp parallel do
    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. )
    !$omp parallel do
    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. )
    !$omp parallel do
    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
 
    !$omp parallel do collapse(4)
    do iq = 1, n_hyd
    do j = 1, dims(3)
    do i = 1, dims(2)
    do k = 1, dims(1)+2
       if ( k<3 .and. .not. sfc_diagnoses ) then
          qhyd_org(k,i,j,iq) = undef
          qnum_org(k,i,j,iq) = undef
       else
          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 if
    end do
    end do
    end do
    end do
 
 
    call file_read( fid, varname_t, read_xyz(:,:,:), step=it, allow_missing=.true. )
    !$omp parallel do
    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
    if ( sfc_diagnoses ) then
       call file_read( fid, "T2", read_xy(:,:), step=it, allow_missing=.false. )
       !$omp parallel do
       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=.false. )
       !$omp parallel do
       do j = 1, dims(3)
       do i = 1, dims(2)
          pres_org(2,i,j) = read_xy(i,j)
       end do
       end do
    else
       !$omp parallel do
       do j = 1, dims(3)
       do i = 1, dims(2)
          temp_org(2,i,j) = undef
          pres_org(2,i,j) = undef
       end do
       end do
    end if
 
    !$omp parallel 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
 
    !$omp parallel do &
    !$omp private(dens)
    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
       if ( sfc_diagnoses ) then
          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)
       else
          pott_org(2,i,j) = undef
          temp_org(1,i,j) = undef
          pres_org(1,i,j) = undef
       end if
    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 )
    !$omp parallel do
    do j = 1, ldims(3)
    do i = 1, ldims(2)
       llat_org(i,j) = llat_org(i,j) * d2r
    end do
    end do
 
    call file_read( fid, "XLONG", llon_org(:,:), step=it )
    !$omp parallel do
    do j = 1, ldims(3)
    do i = 1, ldims(2)
       llon_org(i,j) = llon_org(i,j) * d2r
    end do
    end do
 
    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 )
    !$omp parallel do
    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 )
       !$omp parallel do
       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 )
!    !$omp parallel do
!    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 )
 
    !$omp parallel do
    do j = 1, ldims(3)
    do i = 1, ldims(2)
       ust_org(i,j) = lst_org(i,j)
    end do
    end do
 
    ! ALBEDO [-]
    call file_read( fid, "ALBEDO", albg_org(:,:,i_r_direct ,i_r_vis), step=it )
    !$omp parallel do
    do j = 1, ldims(3)
    do i = 1, ldims(2)
       albg_org(i,j,i_r_direct ,i_r_nir) = albg_org(i,j,i_r_direct ,i_r_vis)
       albg_org(i,j,i_r_diffuse,i_r_nir) = albg_org(i,j,i_r_direct ,i_r_vis)
       albg_org(i,j,i_r_diffuse,i_r_vis) = albg_org(i,j,i_r_direct ,i_r_vis)
    end do
    end do
 
    ! SURFACE EMISSIVITY [-]
    call file_read( fid, "EMISS", read_xy(:,:), step=it )
    !$omp parallel do
    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
    !$omp parallel do
    do j = 1, ldims(3)
    do i = 1, ldims(2)
       albg_org(i,j,i_r_direct,i_r_ir) = albg_org(i,j,i_r_diffuse,i_r_ir)
    end do
    end do
 
!    ! 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 )
!    !$omp parallel do
!    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 )
    !$omp parallel do
    do j = 1, odims(2)
    do i = 1, odims(1)
       olat_org(i,j) = olat_org(i,j) * d2r
    end do
    end do
 
    call file_read( fid, "XLONG", olon_org(:,:), step=it )
    !$omp parallel do
    do j = 1, odims(2)
    do i = 1, odims(1)
       olon_org(i,j) = olon_org(i,j) * d2r
    end do
    end do
 
 
    ! 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 )
    !$omp parallel do
    do j = 1, odims(2)
    do i = 1, odims(1)
       tw_org(i,j) = sst_org(i,j)
    end do
    end do
 
    ! ALBEDO [-]
    call file_read( fid, "ALBEDO", albw_org(:,:,i_r_direct ,i_r_vis), step=it )
    !$omp parallel do
    do j = 1, odims(2)
    do i = 1, odims(1)
       albw_org(i,j,i_r_direct ,i_r_nir) = albw_org(i,j,i_r_direct ,i_r_vis)
       albw_org(i,j,i_r_diffuse,i_r_nir) = albw_org(i,j,i_r_direct ,i_r_vis)
       albw_org(i,j,i_r_diffuse,i_r_vis) = albw_org(i,j,i_r_direct ,i_r_vis)
    end do
    end do
 
    ! SURFACE EMISSIVITY [-]
    call file_read( fid, "EMISS", read_xy(:,:), step=it )
    !$omp parallel do
    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
    !$omp parallel do
    do j = 1, odims(2)
    do i = 1, odims(1)
       albw_org(i,j,i_r_direct,i_r_ir) = albw_org(i,j,i_r_diffuse,i_r_ir)
    end do
    end do
 
    ! 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
       !$omp parallel do
       do j = 1, j1
       do i = 1, i1
       do k = 1, k1
          u_latlon(k,i,j) = u_on_map(k,i,j)
          v_latlon(k,i,j) = v_on_map(k,i,j)
       end do
       end do
       end do
 
       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
 
    !$omp parallel do &
    !$omp private(diff,alpha)
    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
 
    !$omp parallel do
    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