!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!! !!
!! GNU General Public License !!
!! !!
!! This file is part of the Flexible Modeling System (FMS). !!
!! !!
!! FMS is free software; you can redistribute it and/or modify !!
!! it and are expected to follow the terms of the GNU General Public !!
!! License as published by the Free Software Foundation. !!
!! !!
!! FMS is distributed in the hope that it will be useful, !!
!! but WITHOUT ANY WARRANTY; without even the implied warranty of !!
!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !!
!! GNU General Public License for more details. !!
!! !!
!! You should have received a copy of the GNU General Public License !!
!! along with FMS; if not, write to: !!
!! Free Software Foundation, Inc. !!
!! 59 Temple Place, Suite 330 !!
!! Boston, MA 02111-1307 USA !!
!! or see: !!
!! http://www.gnu.org/licenses/gpl.txt !!
!! !!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
module atmos_model_mod
use mpp_mod, only : mpp_npes, mpp_pe, mpp_error, FATAL
use mpp_domains_mod, only : domain2d
use mpp_domains_mod, only : mpp_define_layout, mpp_define_domains
use mpp_domains_mod, only : CYCLIC_GLOBAL_DOMAIN, mpp_get_data_domain
use mpp_domains_mod, only : mpp_get_compute_domain, mpp_get_tile_id
use mpp_domains_mod, only : mpp_get_current_ntile
use fms_mod, only : field_exist, read_data, field_size
use time_manager_mod, only : time_type
use coupler_types_mod, only : coupler_2d_bc_type
use diag_manager_mod, only : diag_axis_init
use diag_integral_mod, only : diag_integral_init
use constants_mod, only : cp_air, hlv
use mosaic_mod, only : get_mosaic_ntiles
use xgrid_mod, only : grid_box_type
use grid_mod, only : get_grid_ntiles, define_cube_mosaic
use grid_mod, only : get_grid_size, get_grid_cell_vertices
use grid_mod, only : get_grid_cell_centers
implicit none
private
public atmos_data_type
public atmos_model_end
public atmos_model_init
public ice_atmos_boundary_type
public land_ice_atmos_boundary_type
public land_atmos_boundary_type
public surf_diff_type
public update_atmos_model_down
public update_atmos_model_up
public atm_stock_pe
public atmos_model_restart
!
! This type should be defined in one spot and "used" from there
type surf_diff_type
real, pointer, dimension(:,:) :: dtmass => NULL()
real, pointer, dimension(:,:) :: dflux_t => NULL()
real, pointer, dimension(:,:) :: delta_t => NULL()
real, pointer, dimension(:,:) :: delta_u => NULL()
real, pointer, dimension(:,:) :: delta_v => NULL()
real, pointer, dimension(:,:,:) :: dflux_tr => NULL() ! tracer flux tendency
real, pointer, dimension(:,:,:) :: delta_tr => NULL() ! tracer tendency
real, pointer, dimension(:,:) :: sst_miz => NULL()
end type surf_diff_type
!
!
type atmos_data_type
type (domain2d) :: domain ! domain decomposition
integer :: axes(4) ! axis indices (returned by diag_manager) for the atmospheric grid
! (they correspond to the x, y, pfull, phalf axes)
real, pointer, dimension(:,:) :: lon_bnd => NULL() ! local longitude axis grid box boundaries in radians.
real, pointer, dimension(:,:) :: lat_bnd => NULL() ! local latitude axis grid box boundaries in radians.
real, pointer, dimension(:,:) :: t_bot => NULL() ! temperature at lowest model level
real, pointer, dimension(:,:,:) :: tr_bot => NULL() ! tracers at lowest model level, including specific humidity
real, pointer, dimension(:,:) :: z_bot => NULL() ! height above the surface for the lowest model level
real, pointer, dimension(:,:) :: p_bot => NULL() ! pressure at lowest model level
real, pointer, dimension(:,:) :: u_bot => NULL() ! zonal wind component at lowest model level
real, pointer, dimension(:,:) :: v_bot => NULL() ! meridional wind component at lowest model level
real, pointer, dimension(:,:) :: p_surf => NULL() ! surface pressure
real, pointer, dimension(:,:) :: slp => NULL() ! sea level pressure
real, pointer, dimension(:,:) :: gust => NULL() ! gustiness factor
real, pointer, dimension(:,:) :: coszen => NULL() ! cosine of the zenith angle
real, pointer, dimension(:,:) :: flux_sw => NULL() ! net shortwave flux (W/m2) at the surface
real, pointer, dimension(:,:) :: flux_sw_dir =>NULL()
real, pointer, dimension(:,:) :: flux_sw_dif =>NULL()
real, pointer, dimension(:,:) :: flux_sw_down_vis_dir =>NULL()
real, pointer, dimension(:,:) :: flux_sw_down_vis_dif =>NULL()
real, pointer, dimension(:,:) :: flux_sw_down_total_dir =>NULL()
real, pointer, dimension(:,:) :: flux_sw_down_total_dif =>NULL()
real, pointer, dimension(:,:) :: flux_sw_vis =>NULL()
real, pointer, dimension(:,:) :: flux_sw_vis_dir =>NULL()
real, pointer, dimension(:,:) :: flux_sw_vis_dif =>NULL()
real, pointer, dimension(:,:) :: flux_lw => NULL() ! net longwave flux (W/m2) at the surface
real, pointer, dimension(:,:) :: lprec => NULL() ! mass of liquid precipitation since last time step (Kg/m2)
real, pointer, dimension(:,:) :: fprec => NULL() ! ass of frozen precipitation since last time step (Kg/m2)
logical,pointer,dimension(:,:):: maskmap => NULL() ! A pointer to an array indicating which
! logical processors are actually used for
! the ocean code. The other logical
! processors would be all land points and
! are not assigned to actual processors.
! This need not be assigned if all logical
! processors are used.indicate if a domain region will be loaded.
type (surf_diff_type) :: Surf_diff ! store data needed by the multi-step version of the diffusion algorithm
type (time_type) :: Time ! current time
type (time_type) :: Time_step ! atmospheric time step.
type (time_type) :: Time_init ! reference time.
integer, pointer :: pelist(:) =>NULL() ! pelist where atmosphere is running.
logical :: pe ! current pe.
type(coupler_2d_bc_type) :: fields ! array of fields used for additional tracers
type(grid_box_type) :: grid
end type
!
!
type land_ice_atmos_boundary_type
! variables of this type are declared by coupler_main, allocated by flux_exchange_init.
!quantities going from land+ice to atmos
real, dimension(:,:), pointer :: t =>NULL() ! surface temperature for radiation calculations
real, dimension(:,:), pointer :: albedo =>NULL() ! surface albedo for radiation calculations
real, dimension(:,:), pointer :: albedo_vis_dir =>NULL()
real, dimension(:,:), pointer :: albedo_nir_dir =>NULL()
real, dimension(:,:), pointer :: albedo_vis_dif =>NULL()
real, dimension(:,:), pointer :: albedo_nir_dif =>NULL()
real, dimension(:,:), pointer :: land_frac =>NULL() ! fraction amount of land in a grid box
real, dimension(:,:), pointer :: dt_t =>NULL() ! temperature tendency at the lowest level
real, dimension(:,:,:), pointer :: dt_tr =>NULL() ! tracer tendency at the lowest level, including specific humidity
real, dimension(:,:), pointer :: u_flux =>NULL() ! zonal wind stress
real, dimension(:,:), pointer :: v_flux =>NULL() ! meridional wind stress
real, dimension(:,:), pointer :: dtaudu =>NULL() ! derivative of wind stress w.r.t. the lowest level wind speed
real, dimension(:,:), pointer :: dtaudv =>NULL() ! derivative of wind stress w.r.t. the lowest level wind speed
real, dimension(:,:), pointer :: u_star =>NULL() ! friction velocity
real, dimension(:,:), pointer :: b_star =>NULL() ! bouyancy scale
real, dimension(:,:), pointer :: q_star =>NULL() ! moisture scale
real, dimension(:,:), pointer :: rough_mom =>NULL() ! surface roughness (used for momentum)
real, dimension(:,:,:), pointer :: data =>NULL() !collective field for "named" fields above
integer :: xtype !REGRID, REDIST or DIRECT
end type land_ice_atmos_boundary_type
!
!
type :: land_atmos_boundary_type
real, dimension(:,:), pointer :: data =>NULL() ! quantities going from land alone to atmos (none at present)
end type land_atmos_boundary_type
!
!
!quantities going from ice alone to atmos (none at present)
type :: ice_atmos_boundary_type
real, dimension(:,:), pointer :: data =>NULL() ! quantities going from ice alone to atmos (none at present)
end type ice_atmos_boundary_type
!
!-----------------------------------------------------------------------
character(len=128) :: version = '$Id: atmos_model.F90,v 17.0.4.2 2009/12/01 16:26:21 z1l Exp $'
character(len=128) :: tagname = '$Name: mom4p1_pubrel_dec2009_nnz $'
contains
!#######################################################################
!
!
!
! compute the atmospheric tendencies for dynamics, radiation,
! vertical diffusion of momentum, tracers, and heat/moisture.
!
!
!
! Called every time step as the atmospheric driver to compute the
! atmospheric tendencies for dynamics, radiation, vertical diffusion of
! momentum, tracers, and heat/moisture. For heat/moisture only the
! downward sweep of the tridiagonal elimination is performed, hence
! the name "_down".
!
!
! call update_atmos_model_down( Surface_boundary, Atmos )
!
!
! Derived-type variable that contains quantities going from land+ice to atmos.
!
!
! Derived-type variable that contains fields needed by the flux exchange module.
! These fields describe the atmospheric grid and are needed to
! compute/exchange fluxes with other component models. All fields in this
! variable type are allocated for the global grid (without halo regions).
!
subroutine update_atmos_model_down( Surface_boundary, Atmos )
!-----------------------------------------------------------------------
! atmospheric driver
! performs radiation, damping, and vertical diffusion of momentum,
! tracers, and downward heat/moisture
!
!-----------------------------------------------------------------------
type(land_ice_atmos_boundary_type), intent(in) :: Surface_boundary
type (atmos_data_type), intent(in) :: Atmos
return
end subroutine update_atmos_model_down
!
!#######################################################################
!
!
!-----------------------------------------------------------------------
!
! upward vertical diffusion of heat/moisture and moisture processes
!
!
! Called every time step as the atmospheric driver to finish the upward
! sweep of the tridiagonal elimination for heat/moisture and compute the
! convective and large-scale tendencies. The atmospheric variables are
! advanced one time step and tendencies set back to zero.
!
!
! call update_atmos_model_up( Surface_boundary, Atmos )
!
!
! Derived-type variable that contains quantities going from land+ice to atmos.
!
!
! Derived-type variable that contains fields needed by the flux exchange module.
! These fields describe the atmospheric grid and are needed to
! compute/exchange fluxes with other component models. All fields in this
! variable type are allocated for the global grid (without halo regions).
!
subroutine update_atmos_model_up( Surface_boundary, Atmos )
!-----------------------------------------------------------------------
! atmospheric driver
! performs upward vertical diffusion of heat/moisture and
! moisture processes
!
!-----------------------------------------------------------------------
type(land_ice_atmos_boundary_type), intent(in) :: Surface_boundary
type (atmos_data_type), intent(in) :: Atmos
return
end subroutine update_atmos_model_up
!
!#######################################################################
!
!
!
! Routine to initialize the atmospheric model
!
!
! This routine allocates storage and returns a variable of type
! atmos_boundary_data_type, and also reads a namelist input and restart file.
!
!
! call atmos_model_init (Atmos, Time_init, Time, Time_step)
!
!
! The base (or initial) time of the experiment.
!
!
! The current time.
!
!
! The atmospheric model/physics time step.
!
!
! Derived-type variable that contains fields needed by the flux exchange module.
!
subroutine atmos_model_init (Atmos, Time_init, Time, Time_step)
type (atmos_data_type), intent(inout) :: Atmos
type (time_type), intent(in) :: Time_init, Time, Time_step
real, dimension(:,:), allocatable :: glon, glat, glon_bnd, glat_bnd
integer, dimension(:), allocatable :: tile_ids
real, dimension(:,:), allocatable :: area
integer, dimension(2) :: layout
integer :: is, ie, js, je, i
integer :: nlon, nlat, ntile, tile
integer :: ntprog
!---- set the atmospheric model time ------
Atmos % Time_init = Time_init
Atmos % Time = Time
Atmos % Time_step = Time_step
call get_grid_ntiles('ATM',ntile)
call get_grid_size('ATM',1,nlon,nlat)
if(ntile ==1) then
if( ASSOCIATED(Atmos%maskmap) ) then
layout(1) = size(Atmos%maskmap,1)
layout(2) = size(Atmos%maskmap,2)
call mpp_define_domains((/1,nlon,1,nlat/), layout, Atmos%domain, &
xflags = CYCLIC_GLOBAL_DOMAIN, xhalo=1, yhalo=1, maskmap = Atmos%maskmap , name='atmos model')
else
call mpp_define_layout((/1,nlon,1,nlat/), mpp_npes(), layout)
call mpp_define_domains((/1,nlon,1,nlat/), layout, Atmos%domain, &
xflags = CYCLIC_GLOBAL_DOMAIN, xhalo=1, yhalo=1, name='atmos model')
end if
else
if( ASSOCIATED(Atmos%maskmap) ) call mpp_error(FATAL, &
'atmos_model_init: Atmos%maskmap should not be associated when ntile is not 1')
call mpp_define_layout( (/1,nlon,1,nlat/), mpp_npes()/ntile, layout )
call define_cube_mosaic('ATM', Atmos%domain, layout, halo=1)
endif
call mpp_get_compute_domain(Atmos%domain,is,ie,js,je)
allocate ( glon_bnd(nlon+1,nlat+1))
allocate ( glat_bnd(nlon+1,nlat+1))
allocate ( glon(nlon, nlat))
allocate ( glat(nlon, nlat))
allocate ( Atmos%lon_bnd(ie-is+2,je-js+2) )
allocate ( Atmos%lat_bnd(ie-is+2,je-js+2) )
allocate ( area(ie-is+2,je-js+2) )
allocate(tile_ids(mpp_get_current_ntile(Atmos%domain)))
tile_ids = mpp_get_tile_id(Atmos%domain)
tile = tile_ids(1)
deallocate(tile_ids)
call get_grid_cell_vertices('ATM',tile,glon_bnd,glat_bnd)
call get_grid_cell_centers ('ATM',tile,glon, glat)
Atmos%lon_bnd(:,:) = glon_bnd(is:ie+1, js:je+1)*atan(1.0)/45.0
Atmos%lat_bnd(:,:) = glat_bnd(is:ie+1, js:je+1)*atan(1.0)/45.0
if(ntile==1) then
Atmos%axes(1) = diag_axis_init('lon',glon(:,1),'degrees_E','X','longitude',&
set_name='atmos',domain2 = Atmos%domain)
Atmos%axes(2) = diag_axis_init('lat',glat(1,:),'degrees_N','Y','latitude',&
set_name='atmos',domain2 = Atmos%domain)
else
Atmos%axes(1) = diag_axis_init('lon',(/(real(i),i=1,nlon)/),'degrees_E','X','longitude',&
set_name='atmos',domain2 = Atmos%domain)
Atmos%axes(2) = diag_axis_init('lat',(/(real(i),i=1,nlat)/),'degrees_N','Y','latitude',&
set_name='atmos',domain2 = Atmos%domain)
endif
allocate ( Atmos%t_bot(is:ie,js:je) )
allocate ( Atmos%tr_bot(is:ie,js:je,1) ) ! just one tracer dimension for q?
allocate ( Atmos%z_bot(is:ie,js:je) )
allocate ( Atmos%p_bot(is:ie,js:je) )
allocate ( Atmos%u_bot(is:ie,js:je) )
allocate ( Atmos%v_bot(is:ie,js:je) )
allocate ( Atmos%p_surf(is:ie,js:je) )
allocate ( Atmos%slp(is:ie,js:je) )
allocate ( Atmos%gust(is:ie,js:je) )
allocate ( Atmos%coszen(is:ie,js:je) )
allocate ( Atmos%flux_sw(is:ie,js:je) )
allocate ( Atmos % flux_sw_dir (is:ie,js:je) )
allocate ( Atmos % flux_sw_dif (is:ie,js:je) )
allocate ( Atmos % flux_sw_down_vis_dir (is:ie,js:je) )
allocate ( Atmos % flux_sw_down_vis_dif (is:ie,js:je) )
allocate ( Atmos % flux_sw_down_total_dir (is:ie,js:je) )
allocate ( Atmos % flux_sw_down_total_dif (is:ie,js:je) )
allocate ( Atmos % flux_sw_vis (is:ie,js:je) )
allocate ( Atmos % flux_sw_vis_dir (is:ie,js:je) )
allocate ( Atmos % flux_sw_vis_dif(is:ie,js:je) )
allocate ( Atmos%flux_lw(is:ie,js:je) )
allocate ( Atmos%lprec(is:ie,js:je) )
allocate ( Atmos%fprec(is:ie,js:je) )
Atmos%t_bot=273.0
Atmos%tr_bot = 0.0
Atmos%z_bot = 10.0
Atmos%p_bot = 1.e5
Atmos%u_bot = 0.0
Atmos%v_bot = 0.0
Atmos%p_surf = 1.e5
Atmos%slp = 1.e5
Atmos%gust = 0.0
Atmos%coszen = 0.0
Atmos%flux_sw = 0.0
Atmos%flux_lw = 0.0
Atmos % flux_sw_dir = 0.0
Atmos % flux_sw_dif = 0.0
Atmos % flux_sw_down_vis_dir = 0.0
Atmos % flux_sw_down_vis_dif = 0.0
Atmos % flux_sw_down_total_dir = 0.0
Atmos % flux_sw_down_total_dif = 0.0
Atmos % flux_sw_vis = 0.0
Atmos % flux_sw_vis_dir = 0.0
Atmos % flux_sw_vis_dif = 0.0
Atmos%lprec = 0.0
Atmos%fprec = 0.0
ntprog = 1
allocate ( Atmos%Surf_diff%dtmass(is:ie, js:je) )
allocate ( Atmos%Surf_diff%dflux_t(is:ie, js:je) )
allocate ( Atmos%Surf_diff%delta_t(is:ie, js:je) )
allocate ( Atmos%Surf_diff%delta_u(is:ie, js:je) )
allocate ( Atmos%Surf_diff%delta_v(is:ie, js:je) )
allocate ( Atmos%Surf_diff%dflux_tr(is:ie, js:je, ntprog) )
allocate ( Atmos%Surf_diff%delta_tr(is:ie, js:je, ntprog) )
Atmos%Surf_diff%dtmass = 0.0
Atmos%Surf_diff%dflux_t = 0.0
Atmos%Surf_diff%delta_t = 0.0
Atmos%Surf_diff%delta_u = 0.0
Atmos%Surf_diff%delta_v = 0.0
Atmos%Surf_diff%dflux_tr = 0.0
Atmos%Surf_diff%delta_tr = 0.0
area = 0.0
call diag_integral_init (Time_init, Time, Atmos%lon_bnd, Atmos%lat_bnd, area )
allocate ( Atmos%grid%dx ( is:ie , js:je+1))
allocate ( Atmos%grid%dy ( is:ie+1, js:je ))
allocate ( Atmos%grid%area ( is:ie , js:je ))
allocate ( Atmos%grid%edge_w( js:je+1))
allocate ( Atmos%grid%edge_e( js:je+1))
allocate ( Atmos%grid%edge_s( is:ie+1 ))
allocate ( Atmos%grid%edge_n( is:ie+1 ))
allocate ( Atmos%grid%en1 (3, is:ie , js:je+1))
allocate ( Atmos%grid%en2 (3, is:ie+1, js:je ))
allocate ( Atmos%grid%vlon (3, is:ie , js:je ))
allocate ( Atmos%grid%vlat (3, is:ie , js:je ))
Atmos%grid%dx = 0.0
Atmos%grid%dy = 0.0
Atmos%grid%area = 0.0
Atmos%grid%edge_w= 0.0
Atmos%grid%edge_e= 0.0
Atmos%grid%edge_s= 0.0
Atmos%grid%edge_n= 0.0
Atmos%grid%en1 = 0.0
Atmos%grid%en2 = 0.0
Atmos%grid%vlon = 0.0
Atmos%grid%vlat = 0.0
return
end subroutine atmos_model_init
!
!#######################################################################
!
!
!
! termination routine for atmospheric model
!
!
! Call once to terminate this module and any other modules used.
! This routine writes a restart file and deallocates storage
! used by the derived-type variable atmos_boundary_data_type.
!
!
! call atmos_model_end (Atmos)
!
!
! Derived-type variable that contains fields needed by the flux exchange module.
!
subroutine atmos_model_end (Atmos)
type (atmos_data_type), intent(in) :: Atmos
return
end subroutine atmos_model_end
!
!#######################################################################
!
!
! dummy routines.
!
subroutine atmos_model_restart(Atmos, timestamp)
type (atmos_data_type), intent(inout) :: Atmos
character(len=*), intent(in) :: timestamp
end subroutine atmos_model_restart
!
subroutine atm_stock_pe (Atm, index, value)
type (atmos_data_type), intent(inout) :: Atm
integer, intent(in) :: index
real, intent(out) :: value
value = 0.0
end subroutine atm_stock_pe
end module atmos_model_mod