mod_atmos_phy_sfc_vars.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#include "scaleFElib.h"
module mod_atmos_phy_sfc_vars
  !-----------------------------------------------------------------------------
  !
  !++ Used modules
  !
  use scale_precision
  use scale_io
  use scale_prc
 
  use scale_element_base, only: elementbase3d
  use scale_mesh_base, only: meshbase
  use scale_mesh_base2d, only: meshbase2d
  use scale_mesh_base3d, only: &
    meshbase3d,                              &
    dimtype_xyz  => meshbase3d_dimtypeid_xyz
  use scale_localmesh_base, only: localmeshbase
  use scale_localmesh_3d, only: localmesh3d
  use scale_localmeshfield_base, only: localmeshfieldbase
  use scale_meshfield_base, only: &
    meshfieldbase, meshfield2d, meshfield3d
 
  use scale_file_restart_meshfield, only: &
    file_restart_meshfield_component
  
  use scale_model_var_manager, only: &
    modelvarmanager, variableinfo
  use scale_model_mesh_manager, only: modelmeshbase
    
  use mod_atmos_mesh, only: atmosmesh
 
  !-----------------------------------------------------------------------------
  implicit none
  private
 
 
  !-----------------------------------------------------------------------------
  !
  !++ Public type & procedures
  !
  type, public :: atmosphysfcvars
    type(meshfield2d), allocatable :: sfc_vars(:)
    type(modelvarmanager) :: sfcvars_manager
 
    type(meshfield2d), allocatable :: sfc_flx(:)
    type(modelvarmanager) :: sfcflx_manager
 
    integer :: sfcflx_num_tot
  contains
    procedure :: init => atmosphysfcvars_init
    procedure :: final => atmosphysfcvars_final
    procedure :: history => atmosphysfcvars_history
  end type atmosphysfcvars
 
  integer, public, parameter :: atmos_phy_sf_svar_temp_id  = 1
  integer, public, parameter :: atmos_phy_sf_svar_num      = 1
  type(variableinfo), public :: atmos_phy_sf_svar_vinfo(atmos_phy_sf_svar_num)
  DATA atmos_phy_sf_svar_vinfo / &
    variableinfo( atmos_phy_sf_svar_num, 'SFC_TEMP', 'surface skin temperature',    &
                  'K',  2, 'XY',  ''                                             )  /
 
  integer, public, parameter :: atmos_phy_sf_sflx_mu_id  = 1
  integer, public, parameter :: atmos_phy_sf_sflx_mv_id  = 2
  integer, public, parameter :: atmos_phy_sf_sflx_mw_id  = 3
  integer, public, parameter :: atmos_phy_sf_sflx_sh_id  = 4
  integer, public, parameter :: atmos_phy_sf_sflx_lh_id  = 5
  integer, public, parameter :: atmos_phy_sf_sflx_qv_id  = 6
  integer, public, parameter :: atmos_phy_sf_sflx_num1   = 6
 
  type(variableinfo), public :: atmos_phy_sf_sflx_vinfo(atmos_phy_sf_sflx_num1)
  DATA atmos_phy_sf_sflx_vinfo / &
    variableinfo( atmos_phy_sf_sflx_mu_id, 'SFLX_MU', 'x-momentum flux',    &
                  'm/s*kg/m2/s',  2, 'XY',  ''                           ), &
    variableinfo( atmos_phy_sf_sflx_mv_id, 'SFLX_MV', 'y-momentum flux',    &
                  'm/s*kg/m2/s',  2, 'XY',  ''                           ), &
    variableinfo( atmos_phy_sf_sflx_mw_id, 'SFLX_MW', 'z-momentum flux',    &
                  'm/s*kg/m2/s',  2, 'XY',  ''                           ), &
    variableinfo( atmos_phy_sf_sflx_sh_id, 'SFLX_SH', 'sensible heat flux', &
                  'J/m2/s',  2, 'XY',  ''                                ), &
    variableinfo( atmos_phy_sf_sflx_lh_id, 'SFLX_LH', 'latent heat flux',   &
                  'J/m2/s',  2, 'XY',  ''                                ), &
    variableinfo( atmos_phy_sf_sflx_qv_id, 'SFLX_QV', 'water vapor flux',   &
                  'kg/m2/s',  2, 'XY',  ''                               )  / 
 
  public :: atmosphysfcvars_getlocalmeshfields
 
  !-----------------------------------------------------------------------------
  !
  !++ Private procedures
  !
  !-------------------
  !
  !++ Private parameters & variables
  !
  real(rp), private :: atmos_phy_sfc_default_sfc_temp = 300.0_rp
 
contains
  subroutine atmosphysfcvars_init( this, model_mesh )
    implicit none
    class(atmosphysfcvars), target, intent(inout) :: this
    class(modelmeshbase), target, intent(in) :: model_mesh
 
    integer :: v
    integer :: n
    logical :: reg_file_hist
 
    class(atmosmesh), pointer :: atm_mesh
    class(meshbase2d), pointer :: mesh2d
    class(meshbase3d), pointer :: mesh3d
 
    namelist / param_atmos_phy_sfc_vars / &
      atmos_phy_sfc_default_sfc_temp
      
    integer :: ierr
    !--------------------------------------------------
 
    log_info('AtmosPhySfcVars_Init',*)
 
    this%SFCFLX_NUM_TOT = atmos_phy_sf_sflx_num1
 
    !--- read namelist
    rewind(io_fid_conf)
    read(io_fid_conf,nml=param_atmos_phy_sfc_vars,iostat=ierr)
    if( ierr < 0 ) then !--- missing
       log_info("ATMOS_PHY_SFC_vars_setup",*) 'Not found namelist. Default used.'
    elseif( ierr > 0 ) then !--- fatal error
       log_error("ATMOS_PHY_SFC_vars_setup",*) 'Not appropriate names in namelist PARAM_ATMOS_PHY_SFC_VARS. Check!'
       call prc_abort
    endif
    log_nml(param_atmos_phy_sfc_vars)
 
    !- Initialize auxiliary and diagnostic variables
 
    nullify( atm_mesh )
    select type(model_mesh)
    class is (atmosmesh)
      atm_mesh => model_mesh
    end select
    mesh3d => atm_mesh%ptr_mesh
 
    call mesh3d%GetMesh2D( mesh2d )
 
    !----
    call this%SFCVARS_manager%Init()
    allocate( this%SFC_VARS(atmos_phy_sf_svar_num) )
 
    reg_file_hist = .true.    
    do v = 1, atmos_phy_sf_svar_num
      call this%SFCVARS_manager%Regist( &
        atmos_phy_sf_svar_vinfo(v), mesh2d,               & 
        this%SFC_VARS(v), reg_file_hist, fill_zero=.true. )
    end do
 
    do n=1, mesh2d%LOCAL_MESH_NUM
      this%SFC_VARS(atmos_phy_sf_svar_temp_id)%local(n)%val(:,:) = atmos_phy_sfc_default_sfc_temp
    end do
 
    !----
    call this%SFCFLX_manager%Init()
    allocate( this%SFC_FLX(this%SFCFLX_NUM_TOT) )
 
    reg_file_hist = .true.    
    do v = 1, this%SFCFLX_NUM_TOT
      call this%SFCFLX_manager%Regist( &
        atmos_phy_sf_sflx_vinfo(v), mesh2d,              & 
        this%SFC_FLX(v), reg_file_hist, fill_zero=.true. )
    end do
 
    return
  end subroutine atmosphysfcvars_init
 
  subroutine atmosphysfcvars_final( this )
    implicit none
    class(atmosphysfcvars), intent(inout) :: this
 
    !--------------------------------------------------
 
    log_info('AtmosPhySfcVars_Final',*)
 
    call this%SFCVARS_manager%Final()
    deallocate( this%SFC_VARS )
 
    call this%SFCFLX_manager%Final()
    deallocate( this%SFC_FLX )
 
    return
  end subroutine atmosphysfcvars_final
 
!OCL SERIAL
  subroutine atmosphysfcvars_history( this )
    use scale_file_history_meshfield, only: file_history_meshfield_put
    implicit none
    class(atmosphysfcvars), intent(inout) :: this
  
    integer :: v
    integer :: iq
    integer :: hst_id
    !-------------------------------------------------------------------------
 
    do v = 1, atmos_phy_sf_svar_num
      hst_id = this%SFC_VARS(v)%hist_id
      if ( hst_id > 0 ) call file_history_meshfield_put( hst_id, this%SFC_VARS(v) )
    end do
 
    do v = 1, this%SFCFLX_NUM_TOT
      hst_id = this%SFC_FLX(v)%hist_id
      if ( hst_id > 0 ) call file_history_meshfield_put( hst_id, this%SFC_FLX(v) )
    end do
 
    return
  end subroutine atmosphysfcvars_history
 
  subroutine atmosphysfcvars_getlocalmeshfields( domID, mesh, svars_list, sflx_list, &
    SFC_TEMP, SFLX_MU, SFLX_MV, SFLX_MW, SFLX_SH, SFLX_LH, SFLX_QV,              &
    lcmesh3D                                                                     &
    )
 
    use scale_mesh_base, only: meshbase
    use scale_meshfield_base, only: meshfieldbase
    implicit none
 
    integer, intent(in) :: domid
    class(meshbase), intent(in) :: mesh
    class(modelvarmanager), intent(inout) :: svars_list
    class(modelvarmanager), intent(inout) :: sflx_list
    class(localmeshfieldbase), pointer, intent(out) :: sfc_temp
    class(localmeshfieldbase), pointer, intent(out) :: sflx_mu
    class(localmeshfieldbase), pointer, intent(out) :: sflx_mv
    class(localmeshfieldbase), pointer, intent(out) :: sflx_mw
    class(localmeshfieldbase), pointer, intent(out) :: sflx_sh
    class(localmeshfieldbase), pointer, intent(out) :: sflx_lh
    class(localmeshfieldbase), pointer, intent(out) :: sflx_qv
    class(localmesh3d), pointer, intent(out), optional :: lcmesh3d
 
    class(meshfieldbase), pointer :: field   
    class(localmeshbase), pointer :: lcmesh
    !-------------------------------------------------------
 
    !--
    call svars_list%Get(atmos_phy_sf_svar_temp_id, field)
    call field%GetLocalMeshField(domid, sfc_temp)
 
    call sflx_list%Get(atmos_phy_sf_sflx_mu_id, field)
    call field%GetLocalMeshField(domid, sflx_mu)
 
    call sflx_list%Get(atmos_phy_sf_sflx_mv_id, field)
    call field%GetLocalMeshField(domid, sflx_mv)
 
    call sflx_list%Get(atmos_phy_sf_sflx_mw_id, field)
    call field%GetLocalMeshField(domid, sflx_mw)
 
    call sflx_list%Get(atmos_phy_sf_sflx_sh_id, field)
    call field%GetLocalMeshField(domid, sflx_sh)
 
    call sflx_list%Get(atmos_phy_sf_sflx_lh_id, field)
    call field%GetLocalMeshField(domid, sflx_lh)
 
    call sflx_list%Get(atmos_phy_sf_sflx_qv_id, field)
    call field%GetLocalMeshField(domid, sflx_qv)
    !---
    
    if (present(lcmesh3d)) then
      call mesh%GetLocalMesh( domid, lcmesh )
      nullify( lcmesh3d )
 
      select type(lcmesh)
      type is (localmesh3d)
        if (present(lcmesh3d)) lcmesh3d => lcmesh
      end select
    end if
 
    return
  end subroutine atmosphysfcvars_getlocalmeshfields
 
end  module mod_atmos_phy_sfc_vars