convert_lai.f90

CCSM Research Tools: Community Atmosphere Model (CAM)

  call wrap_put_var_realx (ncid, edgen_id   , edge(1))
  call wrap_put_var_realx (ncid, edgee_id   , edge(2))
  call wrap_put_var_realx (ncid, edges_id   , edge(3))
  call wrap_put_var_realx (ncid, edgew_id   , edge(4))

  ! Read in formatted surface data and write output file
     
  filei2 = '/ptmp/slevis/lsmv2_2/input/0.5x0.5/pft-igbp.5x.5'
  open (unit=ndata2,file=trim(filei2),status='unknown',&
       form='formatted',iostat=status)
  do j = 1, nlat
     do i = 1, nlon
        read (ndata2,*) landmask(i,j)
        if (landmask(i,j) == 100.) landmask(i,j) = 1.
     end do
  end do
  close(ndata2)

! write out landmask

  call wrap_put_var_realx (ncid, landmask_id, landmask)

! now enter time loop

  do ntim = 1,12

     if (ntim .eq.  1) filei = '/ptmp/slevis/lsmv2_2/input/0.5x0.5/01-0000'
     if (ntim .eq.  2) filei = '/ptmp/slevis/lsmv2_2/input/0.5x0.5/02-0000'
     if (ntim .eq.  3) filei = '/ptmp/slevis/lsmv2_2/input/0.5x0.5/03-0000'
     if (ntim .eq.  4) filei = '/ptmp/slevis/lsmv2_2/input/0.5x0.5/04-0000'
     if (ntim .eq.  5) filei = '/ptmp/slevis/lsmv2_2/input/0.5x0.5/05-0000'
     if (ntim .eq.  6) filei = '/ptmp/slevis/lsmv2_2/input/0.5x0.5/06-0000'
     if (ntim .eq.  7) filei = '/ptmp/slevis/lsmv2_2/input/0.5x0.5/07-0000'
     if (ntim .eq.  8) filei = '/ptmp/slevis/lsmv2_2/input/0.5x0.5/08-0000'
     if (ntim .eq.  9) filei = '/ptmp/slevis/lsmv2_2/input/0.5x0.5/09-0000'
     if (ntim .eq. 10) filei = '/ptmp/slevis/lsmv2_2/input/0.5x0.5/10-0000'
     if (ntim .eq. 11) filei = '/ptmp/slevis/lsmv2_2/input/0.5x0.5/11-0000'
     if (ntim .eq. 12) filei = '/ptmp/slevis/lsmv2_2/input/0.5x0.5/12-0000'

     ! Read input data

     write(6,*)'ntim= ',ntim, ' filei= ',filei ;  call flush(6)

     open (unit=ndata,file=trim(filei),status='unknown',&
          form='formatted',iostat=status)
     if (status .ne. 0) then
        write (6,*)'failed to open ',trim(filei),' on unit ',&
             ndata,' ierr=',status
        stop
     end if

     mlai(:,:,0)  = 0. 
     msai(:,:,0)  = 0.
     mhgtt(:,:,0) = 0.
     mhgtb(:,:,0) = 0.
     do j = 1, nlat
        do i = 1, nlon
           read (ndata,*) (mlai(i,j,l) , l=1,numpft), &
                readdum,  (msai(i,j,l) , l=1,numpft), &
                readdum,  (mhgtt(i,j,l), l=1,numpft), &
                readdum,  (mhgtb(i,j,l), l=1,numpft)  
           if (landmask(i,j) == 0.) then
              do l = 1, numpft
                 mlai(i,j,l) = 0.
                 msai(i,j,l) = 0.
                 mhgtt(i,j,l) = 0.
                 mhgtb(i,j,l) = 0.
              end do
           end if
        end do
     end do
     close(ndata)

     ! Write netcdf variables

     beg4d(1) = 1     ; len4d(1) = nlon
     beg4d(2) = 1     ; len4d(2) = nlat
     beg4d(3) = 1     ; len4d(3) = numpft+1
     beg4d(4) = ntim  ; len4d(4) = 1
     
     call wrap_put_vara_realx (ncid, mlai_id , beg4d, len4d, mlai )
     call wrap_put_vara_realx (ncid, msai_id , beg4d, len4d, msai )
     call wrap_put_vara_realx (ncid, mhgtt_id, beg4d, len4d, mhgtt)
     call wrap_put_vara_realx (ncid, mhgtb_id, beg4d, len4d, mhgtb)

  end do   

  ! Close output file

  call wrap_close(ncid)

end program convert_lai

!===============================================================================

subroutine wrap_create (path, cmode, ncid)
  implicit none
  include 'netcdf.inc'
  integer, parameter :: r8 = selected_real_kind(12)
  character(len=*) path
  integer cmode, ncid, ret
  ret = nf_create (path, cmode, ncid)
  if (ret.ne.NF_NOERR) call handle_error (ret)
end subroutine wrap_create

!===============================================================================

subroutine wrap_def_dim (nfid, dimname, len, dimid)
  implicit none
  include 'netcdf.inc'
  integer, parameter :: r8 = selected_real_kind(12)
  integer :: nfid, len, dimid
  character(len=*) :: dimname
  integer ret
  ret = nf_def_dim (nfid, dimname, len, dimid)
  if (ret.ne.NF_NOERR) call handle_error (ret)
end subroutine wrap_def_dim

!===============================================================================

subroutine wrap_def_var (nfid, name, xtype, nvdims, vdims, varid)
  implicit none
  include 'netcdf.inc'
  integer, parameter :: r8 = selected_real_kind(12)
  integer :: nfid, xtype, nvdims, varid
  integer :: vdims(nvdims)
  character(len=*) :: name
  integer ret
  ret = nf_def_var (nfid, name, xtype, nvdims, vdims, varid)
  if (ret.ne.NF_NOERR) call handle_error (ret)
end subroutine wrap_def_var

!===============================================================================

subroutine wrap_put_att_text (nfid, varid, attname, atttext)
  implicit none
  include 'netcdf.inc'
  integer, parameter :: r8 = selected_real_kind(12)
  integer :: nfid, varid
  character(len=*) :: attname, atttext
  integer :: ret, siz
  siz = len_trim(atttext)
  ret = nf_put_att_text (nfid, varid, attname, siz, atttext)
  if (ret.ne.NF_NOERR) call handle_error (ret)
end subroutine wrap_put_att_text

!===============================================================================

subroutine wrap_put_var_realx (nfid, varid, arr)
  implicit none
  include 'netcdf.inc'
  integer, parameter :: r8 = selected_real_kind(12)
  integer :: nfid, varid
  real(r8) :: arr(*)
  integer :: ret
#ifdef CRAY
  ret = nf_put_var_real (nfid, varid, arr)
#else
  ret = nf_put_var_double (nfid, varid, arr)
#endif
  if (ret.ne.NF_NOERR) call handle_error (ret)
end subroutine wrap_put_var_realx

!===============================================================================

subroutine wrap_put_var_int (nfid, varid, arr)
  implicit none
  include 'netcdf.inc'
  integer, parameter :: r8 = selected_real_kind(12)
  integer :: nfid, varid
  integer :: arr(*)
  integer :: ret
  ret = nf_put_var_int (nfid, varid, arr)
  if (ret.ne.NF_NOERR) call handle_error (ret)
end subroutine wrap_put_var_int
  
!===============================================================================

subroutine wrap_put_vara_realx (nfid, varid, start, count, arr)
  implicit none
  include 'netcdf.inc'
  integer, parameter :: r8 = selected_real_kind(12)
  integer :: nfid, varid
  integer :: start(*), count(*)
  real(r8) arr(*)
  integer ret
#ifdef CRAY
  ret = nf_put_vara_real (nfid, varid, start, count, arr)
#else
  ret = nf_put_vara_double (nfid, varid, start, count, arr)
#endif
  if (ret.ne.NF_NOERR) call handle_error (ret)
end subroutine wrap_put_vara_realx

!===============================================================================

subroutine wrap_close (ncid)
  implicit none
  include 'netcdf.inc'
  integer, parameter :: r8 = selected_real_kind(12)
  integer :: ncid
  integer :: ret
  ret = nf_close (ncid)
  if (ret.ne.NF_NOERR) then
     write(6,*)'WRAP_CLOSE: nf_close failed for id ',ncid
     call handle_error (ret)
  end if
end subroutine wrap_close

!===============================================================================

subroutine handle_error(ret)
  implicit none
  include 'netcdf.inc'
  integer :: ret
  if (ret .ne. nf_noerr) then
     write(6,*) 'NCDERR: ERROR: ',nf_strerror(ret)
     call abort
  endif
end subroutine handle_error

!===============================================================================