!===============================================================================
! SVN $Id:
! SVN $URL:
!===============================================================================
!BOP ===========================================================================
!
! !MODULE: shr_scam_mod.F90 --- Module to handle single column mode share routines.
!
! !DESCRIPTION:
! Routines needed by drv or several component models for running in single column mode
!
! !REVISION HISTORY:
! 2007 Sep 14 - B. Kauffman - svn checkin
! 2007 Aug 29 - J. Truesdale - first version
!
! !INTERFACE: ------------------------------------------------------------------
module shr_scam_mod 1,6
! !USES:
use shr_kind_mod
! defines kinds
use shr_sys_mod ! system calls
use shr_file_mod ! file utilities
use shr_kind_mod, only : R8=>SHR_KIND_R8,IN=>SHR_KIND_IN,CL=>SHR_KIND_CL
use shr_log_mod, only : s_loglev => shr_log_Level
use shr_log_mod, only : s_logunit => shr_log_Unit
use netcdf
implicit none
private ! By default everything is private to this module
! !PUBLIC TYPES:
! no public types
! !PUBLIC MEMBER FUNCTIONS:
public :: shr_scam_getCloseLatLon ! return lat and lon point/index
public :: shr_scam_checkSurface ! check grid fraction in focndomain dataset
! !PUBLIC DATA MEMBERS:
! no public data members
!EOP
!===============================================================================
CONTAINS
!===============================================================================
!===============================================================================
!BOP ===========================================================================
!
! !IROUTINE: shr_scam_getCloseLatLon(ncid,targetLat,targetLon, closeLat, closeLon,
! closeLatIdx, closeLonIdx)
!
! !DESCRIPTION:
! routine to search in netcdf file and return lat and lon point/index closest to target point
!
! USAGE:
! call shr_scam_getCloseLatLon(ncid,targetLat,targetLon, closeLat, closeLon,
! closeLatIdx, closeLonIdx)
!
! !REVISION HISTORY:
! 2007 Aug 29 - J. Truesdale - first version
!
! !INTERFACE: ------------------------------------------------------------------
subroutine shr_scam_getCloseLatLon(ncid, targetLat, targetLon, closeLat, closeLon, & 1,10
closeLatIdx, closeLonIdx)
implicit none
! !INPUT/OUTPUT PARAMETERS:
integer(IN),intent(in) :: ncid ! netcdf id
real (R8),intent(in) :: targetLat ! find closest latitude to this point
real (R8),intent(in) :: targetLon ! find closest longitude to this point
real (R8),intent(out) :: closeLat ! returned close lat
real (R8),intent(out) :: closeLon ! returned close lon
integer(IN),intent(out) :: closeLatIdx ! index of returned lat point
integer(IN),intent(out) :: closeLonIdx ! index of returned lon point
!EOP
!----- local variables -----
real (R8),allocatable :: lats(:),lons(:),poslons(:)
real (R8) :: postargetlon
integer(IN) :: rcode ! netCDF routine return code
integer(IN) :: i
integer(IN) :: len
integer(IN) :: ndims
integer(IN) :: nvars
integer(IN) :: nvarid
integer(IN) :: ndimid
integer(IN) :: strt(nf90_max_var_dims),count(nf90_max_var_dims)
integer(IN) :: nlon,nlat
integer(IN), dimension(nf90_max_var_dims) :: dimids
character(len=80) :: name,var_name
character(*),parameter :: subname = "(shr_scam_getCloseLatLon) "
!-------------------------------------------------------------------------------
! Notes:
!-------------------------------------------------------------------------------
!--- Get variable info for search ---
rcode = nf90_inquire(ncid, nVariables=nvars)
if (rcode /= nf90_noerr) then
call shr_sys_abort(subname//"ERROR from nf90_inquire ")
endif
!--- Look for/extract lat lon coordinate variables from file ---
nlat=0
nlon=0
nvarid=0
!--- Loop through all Lat variables until we find lat and lon ---
do while (nvarid < nvars .and.(nlon.eq.0 .or. nlat.eq.0))
nvarid=nvarid+1
rcode = nf90_inquire_variable(ncid, nvarid, var_name, ndims=ndims,dimids = dimids)
if (rcode /= nf90_noerr) then
call shr_sys_abort(subname//"ERROR inquiring about variable "//trim(var_name))
endif
!--- is this a latitude variable ---
if ( var_name .eq. 'lat'.or. var_name .eq. 'latixy'.or. var_name .eq. 'yc'.or.var_name.eq.'lsmlat'.or.&
var_name .eq. 'LAT'.or. var_name .eq. 'LATIXY'.or. var_name .eq. 'YC'.or.var_name.eq.'LSMLAT' ) then
!--- Loop through all variable dimensions until we find lat and lon ---
do ndimid = 1,ndims
rcode = nf90_inquire_dimension(ncid, dimids(ndimid), name, len)
if (rcode /= nf90_noerr) then
call shr_sys_abort(subname//"ERROR: Cant read netcdf latitude variable dimension")
endif
if ( name .eq. 'lat'.or. name .eq. 'latixy'.or. name .eq. 'nj'.or. name .eq. 'lsmlat' .or. &
name .eq. 'LAT'.or. name .eq. 'LATIXY'.or. name .eq. 'NJ'.or. name .eq. 'LSMLAT' ) then
strt(ndimid) = 1
count(ndimid) = len
nlat=len
else
strt(ndimid) = 1
count(ndimid) = 1
endif
end do
if (nlat.eq.0) then
call shr_sys_abort( subname//"ERROR: Cant find a useable latitude dimension (lat,nj,latixy, or lsmlat")
endif
allocate(lats(nlat))
rcode= nf90_get_var(ncid, nvarid ,lats, start = strt, count = count)
if (rcode /= nf90_noerr) then
call shr_sys_abort( subname//"ERROR: Cant read netcdf latitude variable dimension")
endif
end if
!--- is this a longitude variable ---
if ( var_name .eq. 'lon'.or. var_name .eq. 'longxy'.or. var_name .eq. 'xc'.or.var_name.eq.'lsmlon'.or.&
var_name .eq. 'LON'.or. var_name .eq. 'LONGXY'.or. var_name .eq. 'XC'.or.var_name.eq.'LSMLON' ) then
do ndimid = 1,ndims
rcode = nf90_inquire_dimension(ncid, dimids(ndimid), name, len)
if (rcode /= nf90_noerr) then
call shr_sys_abort( subname//"ERROR: Cant read netcdf latitude variable dimension")
endif
if ( name .eq. 'lon'.or. name .eq. 'longxy'.or. name .eq. 'ni'.or. name .eq. 'lsmlon' .or. &
name .eq. 'LON'.or. name .eq. 'LONGXY'.or. name .eq. 'NI'.or. name .eq. 'LSMLON' ) then
strt(ndimid) = 1
count(ndimid) = len
nlon=len
else
strt(ndimid) = 1
count(ndimid) = 1
endif
end do
if (nlon.eq.0) then
call shr_sys_abort( subname//"ERROR: Cant find a useable longitude dimension (lon,ni,longxy, or lsmlon")
endif
allocate(lons(nlon))
allocate(poslons(nlon))
rcode= nf90_get_var(ncid, nvarid ,lons, start = strt, count = count)
if (rcode /= nf90_noerr) then
call shr_sys_abort( subname//"ERROR: Cant read netcdf latitude variable dimension")
endif
end if
end do
!--- Did we get find valid lat and lon coordinate variables ---
if (nlon.eq.0) then
call shr_sys_abort( subname//"ERROR: Couldnt find a longitude coordinate variable")
end if
if (nlat.eq.0) then
call shr_sys_abort( subname//"ERROR: Couldnt find a latitude coordinate variable")
end if
!--- convert lons array and targetlon to 0,360 ---
poslons=mod(lons+360._r8,360._r8)
postargetlon=mod(targetlon+360._r8,360._r8)
!--- find index of value closest to 0 and set returned values ---
closelonidx=(MINLOC(abs(poslons-postargetlon),dim=1))
closelatidx=(MINLOC(abs(lats-targetlat),dim=1))
closelon=lons(closelonidx)
closelat=lats(closelatidx)
!--- if it gets here we need to clean up after ourselves ---
deallocate(lats)
deallocate(lons)
deallocate(poslons)
return
end subroutine shr_scam_getCloseLatLon
!===============================================================================
!BOP ===========================================================================
!
! !IROUTINE: shr_scam_checkSurface(scmlon, scmlat, ocn_compid, ocn_mpicom, lnd_present, ocn_present, ice_present)
!
! !DESCRIPTION:
! routine to check grid fraction from the focndomain dataset
! and provide information to correctly flag land, ocean or ice for
! single column mode
!
! !REVISION HISTORY:
! 2007 Aug 29 - J. Truesdale - first version
!
! !INTERFACE: ------------------------------------------------------------------
subroutine shr_scam_checkSurface(scmlon, scmlat, ocn_compid, ocn_mpicom, lnd_present, ocn_present, ice_present) 1,16
! !USES:
use shr_strdata_mod
use shr_dmodel_mod ! shr data model stuff
use mct_mod
implicit none
! !INPUT/OUTPUT PARAMETERS:
real(R8), intent(in) :: scmlon,scmlat ! single column lat lon
integer(IN), intent(in) :: ocn_compid ! id for ocean model
integer(IN), intent(in) :: ocn_mpicom ! mpi communicator for ocean
logical, optional, intent(out) :: lnd_present ! land point
logical, optional, intent(out) :: ice_present ! ice point
logical, optional, intent(out) :: ocn_present ! ocean point
!EOP
!----- local variables -----
integer(IN) :: rcode ! error code
integer(IN) :: ncid_ocn ! netcdf id for ocn_in
integer(IN) :: fracid ! id for frac variable
integer(IN) :: closeLatIdx ! index of returned lat point
integer(IN) :: closeLonIdx ! index of returned lon point
integer(IN) :: unitn ! io unit
real (R8) :: ocn_frac(1,1) ! ocean fraction
real (R8) :: closeLat ! returned close lat
real (R8) :: closeLon ! returned close lon
character(len=CL) :: nrevsn = ' ' ! full path restart file for branch
character(len=CL) :: rest_pfile = './rpointer.dom' ! restart pointer file
character(len=CL) :: bndtvs ! sst file
character(len=CL) :: focndomain ! ocn domain file
logical :: sstcyc ! flag for sst cycling
logical :: docn_exists ! flag if file exists locally
logical :: ocn_exists ! flag if file exists locally
logical :: exists ! flag if file exists locally
logical :: aqua_planet ! flags
logical :: single_column ! flags
!----- formats -----
character(*),parameter :: subname = "(shr_scam_checkSurface) "
character(*),parameter :: F00 = "('(shr_scam_checkSurface) ',8a)"
type(shr_strdata_type) :: SDAT
character(len=CL) :: decomp = '1d' ! restart pointer file
character(len=CL) :: restfilm = 'unset'
character(len=CL) :: restfils = 'unset'
character(len=CL) :: ocn_in = 'unset'
integer(IN) :: nfrac
namelist /dom_inparm/ sstcyc, nrevsn, rest_pfile, bndtvs, focndomain
namelist / docn_nml / ocn_in, decomp, restfilm, restfils
!-------------------------------------------------------------------------------
! Notes:
!-------------------------------------------------------------------------------
inquire( file='ocn_in', exist=ocn_exists )
inquire( file='docn_in', exist=docn_exists )
if (ocn_exists) then
!--- read in the ocn_in namelist to get name for focndomain file
unitn = shr_file_getUnit() ! get an unused unit number
open( unitn, file='ocn_in', status='old' )
rcode = 1
do while ( rcode /= 0 )
read(unitn, dom_inparm, iostat=rcode)
if (rcode < 0) then
call shr_sys_abort( 'shr_scam_checkSurface encountered end-of-file on namelist read' )
endif
end do
close( unitn )
call shr_file_freeUnit(unitn)
!--- open the netcdf file ---
inquire(file=trim(focndomain),exist=exists)
if (.not.exists) call shr_sys_abort(subName//"ERROR: file does not exist: "//trim(focndomain))
rcode = nf90_open(focndomain,nf90_nowrite,ncid_ocn)
if (rCode /= nf90_noerr) call shr_sys_abort(subName//"ERROR opening data file : "//trim(focndomain))
if (s_loglev > 0) write(s_logunit,F00) 'opened netCDF data file: ',trim(focndomain)
!--- Extract the fraction for current column ---
call shr_scam_getCloseLatLon(ncid_ocn,scmlat,scmlon,closelat,closelon,closelatidx,closelonidx)
rcode = nf90_inq_varid(ncid_ocn, 'frac', fracid)
if (rcode /= nf90_noerr) then
call shr_sys_abort(subname//"ERROR getting varid from variable frac in file "//trim(focndomain))
end if
rcode = nf90_get_var(ncid_ocn,fracid,ocn_frac,start=(/closelonidx,closelatidx/),count=(/1,1/))
if (rcode /= nf90_noerr) then
call shr_sys_abort(subname//"ERROR getting ocean fraction from "//trim(focndomain))
end if
!--- Set the appropriate surface flags based on ocean fraction.
if ( present(ocn_present) ) ocn_present=(ocn_frac(1,1).gt.0.)
if ( present(ocn_present).and.present(ice_present)) ice_present=ocn_present
if ( present(lnd_present)) lnd_present=(ocn_frac(1,1).lt.1.)
else if (docn_exists) then
!--- read in the ocn_in namelist to get name for focndomain file
unitn = shr_file_getUnit() ! get an unused unit number
open( unitn, file='docn_in', status='old' )
rcode = 1
do while ( rcode /= 0 )
read (unitn,nml=docn_nml,iostat=rcode)
if (rcode < 0) then
call shr_sys_abort( 'shr_scam_checkSurface encountered end-of-file on namelist read' )
endif
end do
close( unitn )
call shr_file_freeUnit(unitn)
call shr_strdata_readnml(SDAT,ocn_in)
call shr_dmodel_readgrid(SDAT%grid,SDAT%gsmap,SDAT%nxg,SDAT%nyg, &
SDAT%domainfile, ocn_compid, ocn_mpicom, '1d', readfrac=.true., &
scmmode=.true.,scmlon=scmlon,scmlat=scmlat)
nfrac = mct_aVect_indexRA(SDAT%grid%data,'frac')
if ( present(ocn_present) ) ocn_present=(SDAT%grid%data%rAttr(nfrac,1).gt.0.)
if ( present(ocn_present).and.present(ice_present)) ice_present=ocn_present
if ( present(lnd_present)) lnd_present=(SDAT%grid%data%rAttr(nfrac,1).lt.1.)
else
! Exit early if no ocn component
if ( present(ocn_present) ) ocn_present=.false.
if ( present(ice_present) ) ice_present=.false.
if ( present(lnd_present) ) lnd_present=.true.
end if
end subroutine shr_scam_checkSurface
!===============================================================================
end module shr_scam_mod