comsrf.f90

来自「CCSM Research Tools: Community Atmospher」· F90 代码 · 共 480 行 · 第 1/2 页

#include <misc.h>
#include <params.h>

!-----------------------------------------------------------------------
!
! !MODULE: comsrf
!
! !DESCRIPTION:	Module to handle surface fluxes for the subcomponents of cam/csm
!
! Public interfaces:
!
!	update       
!	init           
!	zero           
!
!-----------------------------------------------------------------------
module comsrf
!
! USES:
!
  use precision
  use tracers, only: pcnst, pnats
  use ppgrid, only: pcols, begchunk, endchunk, pvermx
  use phys_grid, only: get_ncols_p
  use infnan

  implicit none

!----------------------------------------------------------------------- 
! PUBLIC: Make default data and interfaces private
!----------------------------------------------------------------------- 
!
! ! PUBLIC MEMBER FUNCTIONS:
!
  public initialize_comsrf          ! Set the surface temperature and sea-ice fraction

  public   ! By default all data is public to this module

  public surface_state
  public srfflx_state
  public srfflx_parm

! Public interfaces

  public srfflx_parm_reset
  public srfflx_state_reset
  public update_srf_fractions
  public update_srf_fluxes

  integer, parameter :: plevmx = 4       ! number of subsurface levels

  character*8 tsnam(plevmx)              ! names of sub-surface temperature fields

  real(r8), allocatable:: landm(:,:)     ! land/ocean/sea ice flag
  real(r8), allocatable:: sgh(:,:)       ! land/ocean/sea ice flag
  real(r8), allocatable:: sicthk(:,:)    ! cam sea-ice thickness (m)
  real(r8), allocatable:: snowhice(:,:)  ! snow depth (liquid water) ovr ice
  real(r8), allocatable:: snowhland(:,:) !snow depth (liquid water) ovr lnd
  real(r8), allocatable:: fsns(:,:)      ! surface absorbed solar flux
  real(r8), allocatable:: fsnt(:,:)      ! Net column abs solar flux at model top
  real(r8), allocatable:: flns(:,:)      ! Srf longwave cooling (up-down) flux
  real(r8), allocatable:: flnt(:,:)      ! Net outgoing lw flux at model top
  real(r8), allocatable:: srfrpdel(:,:)  ! 1./(pint(k+1)-pint(k))
  real(r8), allocatable:: psm1(:,:)      ! surface pressure
  real(r8), allocatable:: absorb(:,:)    ! cam surf absorbed solar flux (W/m2)
  real(r8), allocatable:: prcsnw(:,:)    ! cam tot snow precip
  real(r8), allocatable:: landfrac(:,:)  ! fraction of sfc area covered by land
  real(r8), allocatable:: ocnfrac(:,:)   ! frac of sfc area covered by open ocean
  real(r8), allocatable:: icefrac(:,:)   ! fraction of sfc area covered by seaice
  real(r8), allocatable:: previcefrac(:,:) ! fraction of sfc area covered by seaice
  real(r8), allocatable:: trefmxav(:,:)  ! diagnostic: tref max over the day
  real(r8), allocatable:: trefmnav(:,:)  ! diagnostic: tref min over the day

  real(r8), allocatable:: asdirice(:,:)
  real(r8), allocatable:: aldirice(:,:)
  real(r8), allocatable:: asdifice(:,:)
  real(r8), allocatable:: aldifice(:,:)
  real(r8), allocatable:: tsice(:,:)

!---------------------------------------------------------------------------
  type surface_state
     real(r8) :: tbot(pcols)         ! bot level temperature
     real(r8) :: zbot(pcols)         ! bot level height above surface
     real(r8) :: ubot(pcols)         ! bot level u wind
     real(r8) :: vbot(pcols)         ! bot level v wind
     real(r8) :: qbot(pcols)         ! bot level specific humidity
     real(r8) :: pbot(pcols)         ! bot level pressure
     real(r8) :: flwds(pcols)        ! 
     real(r8) :: precsc(pcols)       !
     real(r8) :: precsl(pcols)       !
     real(r8) :: precc(pcols)        ! 
     real(r8) :: precl(pcols)        ! 
     real(r8) :: soll(pcols)         ! 
     real(r8) :: sols(pcols)         ! 
     real(r8) :: solld(pcols)        !
     real(r8) :: solsd(pcols)        !
     real(r8) :: srfrad(pcols)       !
     real(r8) :: thbot(pcols)        ! 
     real(r8) :: tssub(pcols,plevmx) ! cam surface/subsurface temperatures
  end type surface_state

  type srfflx_state
     integer :: lchnk     ! chunk index
     integer :: ncol      ! number of active columns

     real(r8) :: asdir(pcols)            ! albedo: shortwave, direct
     real(r8) :: asdif(pcols)            ! albedo: shortwave, diffuse
     real(r8) :: aldir(pcols)            ! albedo: longwave, direct
     real(r8) :: aldif(pcols)            ! albedo: longwave, diffuse
     real(r8) :: lwup(pcols)             ! longwave up radiative flux
     real(r8) :: lhf(pcols)              ! latent heat flux
     real(r8) :: shf(pcols)              ! sensible heat flux
     real(r8) :: wsx(pcols)              ! surface u-stress (N)
     real(r8) :: wsy(pcols)              ! surface v-stress (N)
     real(r8) :: tref(pcols)             ! ref height surface air temp
     real(r8) :: ts(pcols)               ! sfc temp (merged w/ocean if coupled)
     real(r8) :: cflx(pcols,pcnst+pnats) ! constituent flux (evap)
  end type srfflx_state

!---------------------------------------------------------------------------
! This is for surface fluxes returned from individual parameterizations
!---------------------------------------------------------------------------

  type srfflx_parm
     character(len=24) :: name    ! name of parameterization which produced tendencies

     real(r8) :: asdir(pcols)     ! albedo: shortwave, direct
     real(r8) :: asdif(pcols)     ! albedo: shortwave, diffuse
     real(r8) :: aldir(pcols)     ! albedo: longwave, direct
     real(r8) :: aldif(pcols)     ! albedo: longwave, diffuse
     real(r8) :: lwup(pcols)      ! longwave up radiative flux
     real(r8) :: lhf(pcols)       ! latent heat flux
     real(r8) :: shf(pcols)       ! sensible heat flux
     real(r8) :: wsx(pcols)       ! surface u-stress (N)
     real(r8) :: wsy(pcols)       ! surface v-stress (N)
     real(r8) :: tref(pcols)      ! ref height surface air temp
     real(r8) :: ts(pcols)        ! sfc temp (merged w/ocean if coupled)
     real(r8) :: cflx(pcols,pcnst+pnats)     ! pcnst+pnats constituent flux (evap)
  end type srfflx_parm

  type (surface_state), allocatable :: surface_state2d(:)
  type (srfflx_state), allocatable :: srfflx_state2d(:)
  type (srfflx_parm), allocatable :: srfflx_parm2d(:)

!===============================================================================
CONTAINS
!===============================================================================

!======================================================================
! PUBLIC ROUTINES: Following routines are publically accessable
!======================================================================
!----------------------------------------------------------------------- 
! 
! BOP
!
! !IROUTINE: initialize_comsrf
!
! !DESCRIPTION:
!
! Initialize the procedure for specifying sea surface temperatures
! Do initial read of time-varying ice boundary dataset, reading two
! consecutive months on either side of the current model date.
!
! Method: 
! 
! Author: 
! 
!-----------------------------------------------------------------------
!
! !INTERFACE
!
  subroutine initialize_comsrf
!-----------------------------------------------------------------------
!
! Purpose:
! Initialize surface data
!
! Method:
!
! Author: Mariana Vertenstein
!
!-----------------------------------------------------------------------
    implicit none

    integer k,c      ! level, constituent indices

    allocate (landm   (pcols,begchunk:endchunk))
    allocate (sgh     (pcols,begchunk:endchunk))
    allocate (sicthk  (pcols,begchunk:endchunk))
    allocate (snowhice(pcols,begchunk:endchunk))
    allocate (snowhland(pcols,begchunk:endchunk))
    allocate (fsns    (pcols,begchunk:endchunk))         
    allocate (fsnt    (pcols,begchunk:endchunk))         
    allocate (flns    (pcols,begchunk:endchunk))         
    allocate (flnt    (pcols,begchunk:endchunk))         
    allocate (srfrpdel(pcols,begchunk:endchunk))
    allocate (psm1    (pcols,begchunk:endchunk))
    allocate (absorb  (pcols,begchunk:endchunk))
    allocate (prcsnw  (pcols,begchunk:endchunk))
    allocate (landfrac(pcols,begchunk:endchunk))
    allocate (ocnfrac (pcols,begchunk:endchunk))
    allocate (icefrac (pcols,begchunk:endchunk))
    allocate (previcefrac (pcols,begchunk:endchunk))
    allocate (trefmxav(pcols,begchunk:endchunk))
    allocate (trefmnav(pcols,begchunk:endchunk))

    allocate (tsice(pcols,begchunk:endchunk))
    allocate (asdirice(pcols,begchunk:endchunk))
    allocate (aldirice(pcols,begchunk:endchunk))
    allocate (asdifice(pcols,begchunk:endchunk))
    allocate (aldifice(pcols,begchunk:endchunk))

    allocate (srfflx_state2d(begchunk:endchunk))
    allocate (srfflx_parm2d(begchunk:endchunk))
    allocate (surface_state2d(begchunk:endchunk))
!
! Initialize to NaN or Inf
!
    landm    (:,:) = inf
    sgh      (:,:) = inf
    sicthk   (:,:) = inf
!
! snowhice and snowhland are only defined for a single surface type
! elements of the array outside valid surface points must be set to
! zero if these fields are to be written to netcdf history files.
!
    snowhice (:,:) = 0.
    snowhland(:,:) = 0.
    fsns     (:,:) = inf
    fsnt     (:,:) = inf
    flns     (:,:) = inf
    flnt     (:,:) = inf
    srfrpdel (:,:) = inf
    psm1     (:,:) = inf
    absorb   (:,:) = inf
    prcsnw   (:,:) = inf
    landfrac (:,:) = inf
    ocnfrac  (:,:) = inf
    icefrac  (:,:) = inf
    previcefrac  (:,:) = inf