mapped_mask.F90

Go to the documentation of this file.

module mapped_mask

  use gengrid_kinds, only : dbl_kind,int_kind,cl,cm,cs
  use grdvars,       only : ni,nj,npx
  use charstrings,   only : dirout,res,atmres,logmsg
  use netcdf

  implicit none

contains


  subroutine make_frac_land(src, wgt)

    character(len=*), intent(in) :: src, wgt

    ! local variables
    integer, parameter :: ntile = 6
    integer(int_kind) :: n_a, n_b, n_s

    integer(int_kind), allocatable, dimension(:) :: col, row
    real(dbl_kind), allocatable, dimension(:) :: s
    real(dbl_kind), allocatable, dimension(:) :: lat1d, lon1d

    integer(int_kind), allocatable, dimension(:) :: src_field
    real(dbl_kind), allocatable, dimension(:) :: dst_field

    real(dbl_kind), allocatable, dimension(:,:)   :: dst2d
    real(dbl_kind), allocatable, dimension(:,:)   :: lat2d,lon2d

    character(len=CS) :: ctile
    character(len=CL) :: fdst
    integer :: i,ii,jj,id,rc,ncid, dim2(2)
    integer :: istr,iend
    integer :: idimid,jdimid

    character(len=CM) :: vname
    !---------------------------------------------------------------------
    ! retrieve the weights
    !---------------------------------------------------------------------

    rc = nf90_open(trim(wgt), nf90_nowrite, ncid)
    rc = nf90_inq_dimid(ncid, 'n_s', id)
    rc = nf90_inquire_dimension(ncid, id, len=n_s)
    rc = nf90_inq_dimid(ncid, 'n_a', id)
    rc = nf90_inquire_dimension(ncid, id, len=n_a)
    rc = nf90_inq_dimid(ncid, 'n_b', id)
    rc = nf90_inquire_dimension(ncid, id, len=n_b)

    allocate(col(1:n_s))
    allocate(row(1:n_s))
    allocate(  s(1:n_s))

    allocate(lat1d(1:n_b))
    allocate(lon1d(1:n_b))

    rc = nf90_inq_varid(ncid, 'col', id)
    rc = nf90_get_var(ncid,     id, col)
    rc = nf90_inq_varid(ncid, 'row', id)
    rc = nf90_get_var(ncid,     id, row)
    rc = nf90_inq_varid(ncid,   'S', id)
    rc = nf90_get_var(ncid,      id,  s)

    ! 1d-tiled lat,lon
    rc = nf90_inq_varid(ncid, 'yc_b',     id)
    rc = nf90_get_var(ncid,       id,  lat1d)
    rc = nf90_inq_varid(ncid, 'xc_b',     id)
    rc = nf90_get_var(ncid,       id,  lon1d)
    rc = nf90_close(ncid)

    !---------------------------------------------------------------------
    ! retrieve 1-d land mask from the SCRIP file and map it
    !---------------------------------------------------------------------

    allocate(src_field(1:n_a))
    allocate(dst_field(1:n_b))

    rc = nf90_open(trim(src), nf90_nowrite, ncid)

    !1-d ocean mask (integer)
    rc = nf90_inq_varid(ncid, 'grid_imask', id)
    rc = nf90_get_var(ncid,     id,  src_field)
    rc = nf90_close(ncid)

    dst_field = 0.0
    do i = 1,n_s
       ii = row(i); jj = col(i)
       dst_field(ii) = dst_field(ii) + s(i)*real(src_field(jj),dbl_kind)
    enddo

    !---------------------------------------------------------------------
    !
    !---------------------------------------------------------------------

    allocate(dst2d(npx,npx))
    allocate(lon2d(npx,npx)); allocate(lat2d(npx,npx))

    do i = 0,ntile-1
       istr = i*npx*npx+1
       iend = istr+npx*npx-1
       !print *,i,istr,iend

       write(ctile,'(a5,i1)')'.tile',i+1
       fdst = trim(dirout)//'/'//trim(atmres)//'.mx'//trim(res)//trim(ctile)//'.nc'
       logmsg = 'creating mapped ocean mask file '//trim(fdst)
       print '(a)',trim(logmsg)

       dst2d(:,:) = reshape(dst_field(istr:iend), (/npx,npx/))
       lat2d(:,:) = reshape(    lat1d(istr:iend), (/npx,npx/))
       lon2d(:,:) = reshape(    lon1d(istr:iend), (/npx,npx/))

       rc = nf90_create(trim(fdst), nf90_64bit_offset, ncid)
       rc = nf90_def_dim(ncid, 'grid_xt', npx, idimid)
       rc = nf90_def_dim(ncid, 'grid_yt', npx, jdimid)

       dim2(:) =  (/idimid, jdimid/)
       vname = 'grid_xt'
       rc = nf90_def_var(ncid, vname, nf90_double, dim2, id)
       vname = 'grid_yt'
       rc = nf90_def_var(ncid, vname, nf90_double, dim2, id)
       vname = 'land_frac'
       rc = nf90_def_var(ncid, vname, nf90_double, dim2, id)
       rc = nf90_enddef(ncid)

       rc = nf90_inq_varid(ncid,    'grid_xt',      id)
       rc = nf90_put_var(ncid,             id,   lon2d)
       rc = nf90_inq_varid(ncid,    'grid_yt',      id)
       rc = nf90_put_var(ncid,             id,   lat2d)
       rc = nf90_inq_varid(ncid,  'land_frac',      id)
       rc = nf90_put_var(ncid,             id,   dst2d)
       rc = nf90_close(ncid)
    end do

    !---------------------------------------------------------------------
    ! clean up
    !---------------------------------------------------------------------

    deallocate(col, row, s, lat1d, lon1d, src_field, dst_field)
    deallocate(dst2d,lon2d,lat2d)

  end subroutine make_frac_land
end module mapped_mask