mksrfdatmod.f90

CCSM Research Tools: Community Atmosphere Model (CAM)

#include <misc.h>
#include <preproc.h>

module mksrfdatMod

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

  subroutine mksrfdat(cam_longxy, cam_latixy, cam_numlon, cam_landfrac, cam_landmask)

!----------------------------------------------------------------------- 
! 
! Purpose: 
! make land model surface dataset from original "raw" data files
! 
! Method: 
! 
! Author: Gordon Bonan, Sam Levis and Mariana Vertenstein
! 
!-----------------------------------------------------------------------
! $Id: mksrfdatMod.F90,v 1.12.2.2 2002/02/16 00:53:48 erik Exp $
!-----------------------------------------------------------------------

    use precision
    use infnan
    use clm_varpar                      !parameters 
    use clm_varctl                      !run control variables
    use clm_varsur                      !land model grid and fractional land
    use pft_varcon                      !vegetation type (PFT) constants   
    use areaMod                         !area averaging routines
    use spmdMod                         !spmd routines and variables
    use surfFileMod                     !write and read surface file
    use histFileMod                     !history file variables
    use mkgridMod                       !land model grid 
    use time_manager, only : is_last_step
    use fileutils, only : putfil, opnfil, getavu, relavu
    implicit none

! ------------------------ arguments -----------------------------------
    real(r8), optional, intent(in) :: cam_longxy(:,:)   !cam lon values
    real(r8), optional, intent(in) :: cam_latixy(:,:)   !cam lat values 
    integer , optional, intent(in) :: cam_numlon(:)     !cam number of longitudes 
    real(r8), optional, intent(in) :: cam_landfrac(:,:) !cam fractional land
    integer , optional, intent(in) :: cam_landmask(:,:) !cam land mask
! ----------------------------------------------------------------------

! ------------------------ local variables -----------------------------
    integer :: i,j,k,m                               !indices
    integer :: ier                                   !error status
    integer :: ndiag                                 !unit number for surface data summary
    character(len=256) :: loc_fn                      !local file name 
    character(len=256) :: rem_dir                    !mass store file name
    character(len=256) :: rem_fn                     !mass store full path name
    character(len=  7) :: resol                      !resolution for file name
    real(r8) :: sum                                  !sum for error check
    real(r8) :: rmax                                 !maximum patch cover
    integer  :: pft(lsmlon,lsmlat,maxpatch_pft)      !PFT data: PFT values
    real(r8) :: pctpft(lsmlon,lsmlat,maxpatch_pft)   !PFT data: % of vegetated area for PFTs
    real(r8) :: pctlnd_pft(lsmlon,lsmlat)            !PFT data: % land per gridcell
    real(r8) :: mlai (lsmlon,lsmlat,maxpatch_pft,12) !monthly lai
    real(r8) :: msai (lsmlon,lsmlat,maxpatch_pft,12) !monthly sai
    real(r8) :: mhgtt(lsmlon,lsmlat,maxpatch_pft,12) !monthly hgt at top
    real(r8) :: mhgtb(lsmlon,lsmlat,maxpatch_pft,12) !monthly hgt at bottom
    logical  :: lremov = .false.                     !true => remove file after dispose
! ----------------------------------------------------------------------

    if (masterproc) then

       write (6,*) 'Attempting to create surface boundary data .....'
       write (6,'(72a1)') ("-",i=1,60)

! ----------------------------------------------------------------------
! Open diagnostic output log file 
! ----------------------------------------------------------------------

       loc_fn = './surface-data.log'
       ndiag = getavu()
       call opnfil (loc_fn, ndiag, 'f')

#if (defined OFFLINE) 
    if (mksrf_offline_fgrid /= ' ') then
       write (ndiag,*)'using fractional land data from file= ', &
            trim(mksrf_offline_fgrid),' to create the surface dataset'
    else
       write (ndiag,*)'using fractional land data from file= ', &
            trim(mksrf_offline_fnavyoro),' to create the surface dataset'
    endif
#elif (defined COUP_CAM) 
       write (ndiag,*)'using fractional land data from cam', &
            ' model to create the surface dataset'
#elif (defined COUP_CSM) 
       write (ndiag,*)'using fractional land data from csm', &
            ' flux coupler to create the surface dataset'
#endif   
       write (ndiag,*) 'PFTs from:         ',trim(mksrf_fvegtyp)
       write (ndiag,*) 'glaciers from:     ',trim(mksrf_fglacier)
       write (ndiag,*) 'urban from:        ',trim(mksrf_furban)
       write (ndiag,*) 'inland water from: ',trim(mksrf_flanwat)
       write (ndiag,*) 'soil texture from: ',trim(mksrf_fsoitex)
       write (ndiag,*) 'soil color from:   ',trim(mksrf_fsoicol)

! ----------------------------------------------------------------------
! Initialize surface variables with unusable values
! ----------------------------------------------------------------------

       soic2d(:,:)   = -999 
       sand3d(:,:,:) = 1.e36
       clay3d(:,:,:) = 1.e36
       pctlak(:,:)   = 1.e36
       pctwet(:,:)   = 1.e36
       pcturb(:,:)   = 1.e36
       pctgla(:,:)   = 1.e36
       pft(:,:,:)    = 0
       pctpft(:,:,:) = 0.

! ----------------------------------------------------------------------
! Determine land model grid, fractional land and land mask
! ----------------------------------------------------------------------

! Initialize grid variables with unusable values

       numlon(:)     = 0
       latixy(:,:)   = 1.e36
       longxy(:,:)   = 1.e36
       landmask(:,:) = -999
       landfrac(:,:) = 1.e36

#if (defined OFFLINE)
       call mkgrid_offline()
#else
       call mkgrid_cam(cam_longxy, cam_latixy, cam_numlon, cam_landfrac, cam_landmask) 
#endif


! ----------------------------------------------------------------------
! Make PFTs [pft, pctpft] from dataset [fvegtyp] (1/2 degree PFT data)
! ----------------------------------------------------------------------

       call mkpft (mksrf_fvegtyp, ndiag,  noveg, pctlnd_pft, pft, pctpft)

! ----------------------------------------------------------------------
! Make inland water [pctlak, pctwet] from Cogley's one degree data [flanwat]
! ----------------------------------------------------------------------

       call mklanwat (mksrf_flanwat, ndiag,  pctlak, pctwet)

! ----------------------------------------------------------------------
! Make glacier fraction [pctgla] from [fglacier] dataset
! ----------------------------------------------------------------------

       call mkglacier (mksrf_fglacier, ndiag, pctgla)

! ----------------------------------------------------------------------
! Make soil texture [sand3d, clay3d] from IGBP 5 minute data [fsoitex]
! ----------------------------------------------------------------------

       call mksoitex (mksrf_fsoitex, ndiag, pctgla, sand3d, clay3d)

! ----------------------------------------------------------------------
! Make soil color classes [soic2d] from BATS T42 data [fsoicol]
! ----------------------------------------------------------------------

       call mksoicol (mksrf_fsoicol, ndiag, pctgla, soic2d)

! ----------------------------------------------------------------------
! Make LAI and SAI from 1/2 degree data
! ----------------------------------------------------------------------

       call mklai (mksrf_flai, ndiag, pft, mlai, msai, mhgtt, mhgtb)

! ----------------------------------------------------------------------
! Make urban fraction [pcturb] from [furban] dataset
! ----------------------------------------------------------------------

       call mkurban (mksrf_furban, ndiag, pcturb) 

! ----------------------------------------------------------------------
! Set LAND values on Ross ice shelf to glacier
! ----------------------------------------------------------------------

       do j = 1,lsmlat
          do i = 1,numlon(j)
             if (latixy(i,j) < -79. .and. landmask(i,j) == 1) then
                soic2d(i,j)   = 0
                pctlak(i,j)   = 0.
                pctwet(i,j)   = 0.
                pcturb(i,j)   = 0.
                pctgla(i,j)   = 100.
                pft(i,j,1)    = noveg
                pctpft(i,j,1) = 100.
                do k = 1,nlevsoi
                   sand3d(i,j,k) = 0.
                   clay3d(i,j,k) = 0.
                end do
                do m = 2,maxpatch_pft
                   pft(i,j,m) = noveg
                   pctpft(i,j,m) = 0.
                end do
             end if
          end do
       end do

! ----------------------------------------------------------------------
! Assume 100% wetland where there is a significant missmatch between the
! land mask and the pft dataset land mask. Also assume medium soil 
! color (4) and loamy texture.
! ----------------------------------------------------------------------

       do j = 1,lsmlat
          do i = 1,numlon(j)
             if (landmask(i,j)==1 .and. nint(pctlnd_pft(i,j))==0) then
                soic2d(i,j)   = 4
                pctlak(i,j)   = 0.
                pctwet(i,j)   = 100.
                pcturb(i,j)   = 0.
                pctgla(i,j)   = 0.
                pctpft(i,j,1) = 100.
                pft(i,j,1)    = noveg
                do k = 1, nlevsoi