CESM_Driver: shr_scam_mod.F90 Source File

00001 !===============================================================================
00002 ! SVN $Id: 
00003 ! SVN $URL: 
00004 !===============================================================================
00005 !BOP ===========================================================================
00006 !
00007 ! !MODULE: shr_scam_mod.F90 --- Module to handle single column mode share routines.
00008 !
00009 ! !DESCRIPTION:
00010 !    Routines needed by drv or several component models for running in single column mode
00011 ! 
00012 ! !REVISION HISTORY:
00013 !    2007 Sep 14 - B. Kauffman  - svn checkin 
00014 !    2007 Aug 29 - J. Truesdale - first version
00015 !
00016 ! !INTERFACE: ------------------------------------------------------------------
00017 
00018 module shr_scam_mod
00019 
00020 ! !USES:
00021 
00022    use shr_kind_mod  ! defines kinds
00023    use shr_sys_mod   ! system calls
00024    use shr_file_mod  ! file utilities
00025    use shr_kind_mod, only : R8=>SHR_KIND_R8,IN=>SHR_KIND_IN,CL=>SHR_KIND_CL
00026    use shr_log_mod,  only : s_loglev  => shr_log_Level
00027    use shr_log_mod,  only : s_logunit => shr_log_Unit
00028    use netcdf
00029 
00030    implicit none
00031 
00032    private           ! By default everything is private to this module
00033 
00034 ! !PUBLIC TYPES:
00035 
00036    ! no public types
00037 
00038 ! !PUBLIC MEMBER FUNCTIONS:
00039 
00040    public :: shr_scam_getCloseLatLon ! return lat and lon point/index
00041    public :: shr_scam_checkSurface   ! check grid fraction in focndomain dataset
00042 
00043 ! !PUBLIC DATA MEMBERS:
00044 
00045    ! no public data members
00046 
00047 !EOP
00048 !===============================================================================
00049 CONTAINS
00050 !===============================================================================
00051 
00052 !===============================================================================
00053 !BOP ===========================================================================
00054 !
00055 ! !IROUTINE: shr_scam_getCloseLatLon(ncid,targetLat,targetLon, closeLat, closeLon, 
00056 !                                    closeLatIdx, closeLonIdx)
00057 !
00058 ! !DESCRIPTION:
00059 !    routine to search in netcdf file and return lat and lon point/index closest to target point
00060 !
00061 ! USAGE:
00062 !    call shr_scam_getCloseLatLon(ncid,targetLat,targetLon, closeLat, closeLon, 
00063 !                                 closeLatIdx, closeLonIdx)
00064 !
00065 ! !REVISION HISTORY:
00066 !     2007 Aug 29 - J. Truesdale - first version
00067 !
00068 ! !INTERFACE: ------------------------------------------------------------------
00069 
00070 subroutine shr_scam_getCloseLatLon(ncid, targetLat,  targetLon, closeLat, closeLon, &
00071                                     closeLatIdx, closeLonIdx)
00072    implicit none
00073 
00074 ! !INPUT/OUTPUT PARAMETERS:
00075 
00076    integer(IN),intent(in)         :: ncid  ! netcdf id
00077    real   (R8),intent(in)         :: targetLat  ! find closest latitude to this point
00078    real   (R8),intent(in)         :: targetLon  ! find closest longitude to this point
00079    real   (R8),intent(out)        :: closeLat   ! returned close lat
00080    real   (R8),intent(out)        :: closeLon   ! returned close lon
00081    integer(IN),intent(out)        :: closeLatIdx  ! index of returned lat point
00082    integer(IN),intent(out)        :: closeLonIdx  ! index of returned lon point
00083 
00084 !EOP
00085 
00086    !----- local variables -----
00087    real   (R8),allocatable          :: lats(:),lons(:),poslons(:)
00088    real   (R8)                      :: postargetlon
00089    integer(IN)                      :: rcode   ! netCDF routine return code
00090    integer(IN)                      ::  i
00091    integer(IN)                      ::  len
00092    integer(IN)                      ::  ndims
00093    integer(IN)                      ::  nvars
00094    integer(IN)                      ::  nvarid
00095    integer(IN)                      ::  ndimid
00096    integer(IN)                      ::  strt(nf90_max_var_dims),count(nf90_max_var_dims)
00097    integer(IN)                      ::  nlon,nlat
00098    integer(IN), dimension(nf90_max_var_dims) :: dimids
00099    character(len=80)                ::  name,var_name
00100    character(*),parameter :: subname = "(shr_scam_getCloseLatLon) "
00101 
00102 !-------------------------------------------------------------------------------
00103 ! Notes:
00104 !-------------------------------------------------------------------------------
00105 
00106    !--- Get variable info for search ---
00107 
00108    rcode = nf90_inquire(ncid, nVariables=nvars)
00109    if (rcode /= nf90_noerr) then
00110       call shr_sys_abort(subname//"ERROR from nf90_inquire ")
00111    endif
00112 
00113    !--- Look for/extract lat lon coordinate variables from file ---
00114 
00115    nlat=0
00116    nlon=0
00117    nvarid=0
00118 
00119    !--- Loop through all Lat variables until we find lat and lon ---
00120 
00121    do while (nvarid < nvars .and.(nlon.eq.0 .or. nlat.eq.0))
00122       nvarid=nvarid+1
00123       rcode = nf90_inquire_variable(ncid, nvarid, var_name, ndims=ndims,dimids = dimids)
00124       if (rcode /= nf90_noerr) then
00125          call shr_sys_abort(subname//"ERROR inquiring about variable "//trim(var_name))
00126       endif
00127 
00128       !--- is this a latitude variable ---
00129 
00130       if ( var_name .eq. 'lat'.or. var_name .eq. 'latixy'.or. var_name .eq. 'yc'.or.var_name.eq.'lsmlat'.or.&
00131            var_name .eq. 'LAT'.or. var_name .eq. 'LATIXY'.or. var_name .eq. 'YC'.or.var_name.eq.'LSMLAT' )  then
00132 
00133          !--- Loop through all variable dimensions until we find lat and lon ---
00134 
00135          do ndimid =  1,ndims
00136             rcode = nf90_inquire_dimension(ncid, dimids(ndimid), name, len)
00137             if (rcode /= nf90_noerr) then
00138                call shr_sys_abort(subname//"ERROR: Cant read netcdf latitude variable dimension")
00139             endif
00140             if ( name .eq. 'lat'.or. name .eq. 'latixy'.or. name .eq. 'nj'.or. name .eq. 'lsmlat' .or. &
00141                  name .eq. 'LAT'.or. name .eq. 'LATIXY'.or. name .eq. 'NJ'.or. name .eq. 'LSMLAT' )  then
00142                strt(ndimid) = 1
00143                count(ndimid) = len
00144                nlat=len
00145             else
00146                strt(ndimid) = 1
00147                count(ndimid) = 1
00148             endif
00149          end do
00150          if (nlat.eq.0) then
00151             call shr_sys_abort( subname//"ERROR: Cant find a useable latitude dimension (lat,nj,latixy, or lsmlat")
00152          endif
00153          allocate(lats(nlat))
00154          rcode= nf90_get_var(ncid, nvarid ,lats, start = strt, count = count)
00155          if (rcode /= nf90_noerr) then
00156             call shr_sys_abort( subname//"ERROR: Cant read netcdf latitude variable dimension")
00157          endif
00158       end if
00159 
00160       !--- is this a longitude variable ---
00161 
00162       if ( var_name .eq. 'lon'.or. var_name .eq. 'longxy'.or. var_name .eq. 'xc'.or.var_name.eq.'lsmlon'.or.&
00163            var_name .eq. 'LON'.or. var_name .eq. 'LONGXY'.or. var_name .eq. 'XC'.or.var_name.eq.'LSMLON' )  then
00164          do ndimid =  1,ndims
00165             rcode = nf90_inquire_dimension(ncid, dimids(ndimid), name, len)
00166             if (rcode /= nf90_noerr) then
00167                call shr_sys_abort( subname//"ERROR: Cant read netcdf latitude variable dimension")
00168             endif
00169             if ( name .eq. 'lon'.or. name .eq. 'longxy'.or. name .eq. 'ni'.or. name .eq. 'lsmlon' .or. &
00170                  name .eq. 'LON'.or. name .eq. 'LONGXY'.or. name .eq. 'NI'.or. name .eq. 'LSMLON' )  then
00171                strt(ndimid) = 1
00172                count(ndimid) = len
00173                nlon=len
00174             else
00175                strt(ndimid) = 1
00176                count(ndimid) = 1
00177             endif
00178          end do
00179          if (nlon.eq.0) then
00180             call shr_sys_abort( subname//"ERROR: Cant find a useable longitude dimension (lon,ni,longxy, or lsmlon")
00181          endif
00182          allocate(lons(nlon))
00183          allocate(poslons(nlon))
00184          rcode= nf90_get_var(ncid, nvarid ,lons, start = strt, count = count)
00185          if (rcode /= nf90_noerr) then
00186             call shr_sys_abort( subname//"ERROR: Cant read netcdf latitude variable dimension")
00187          endif
00188       end if
00189    end do
00190 
00191    !--- Did we get find valid lat and lon coordinate variables ---
00192 
00193    if (nlon.eq.0) then
00194       call shr_sys_abort( subname//"ERROR: Couldnt find a longitude coordinate variable")
00195    end if
00196    if (nlat.eq.0) then
00197       call shr_sys_abort( subname//"ERROR: Couldnt find a latitude coordinate variable")
00198    end if
00199 
00200    !--- convert lons array and targetlon to 0,360 ---
00201 
00202    poslons=mod(lons+360._r8,360._r8)
00203    postargetlon=mod(targetlon+360._r8,360._r8)
00204 
00205    !--- find index of value closest to 0 and set returned values ---
00206 
00207    closelonidx=(MINLOC(abs(poslons-postargetlon),dim=1))
00208    closelatidx=(MINLOC(abs(lats-targetlat),dim=1))
00209    closelon=lons(closelonidx)
00210    closelat=lats(closelatidx)
00211 
00212    !--- if it gets here we need to clean up after ourselves ---
00213 
00214    deallocate(lats)
00215    deallocate(lons)
00216    deallocate(poslons)
00217 
00218    return
00219 
00220 end subroutine shr_scam_getCloseLatLon
00221 
00222 !===============================================================================
00223 !BOP ===========================================================================
00224 !
00225 ! !IROUTINE: shr_scam_checkSurface(scmlon, scmlat, ocn_compid, ocn_mpicom, lnd_present, ocn_present, ice_present)
00226 !
00227 ! !DESCRIPTION:
00228 !    routine to check grid fraction from the focndomain dataset
00229 !    and provide information to correctly flag land, ocean or ice for
00230 !    single column mode
00231 !
00232 ! !REVISION HISTORY:
00233 !     2007 Aug 29 - J. Truesdale - first version
00234 !
00235 ! !INTERFACE: ------------------------------------------------------------------
00236 
00237 subroutine shr_scam_checkSurface(scmlon, scmlat, ocn_compid, ocn_mpicom, lnd_present, ocn_present, ice_present)
00238 
00239 ! !USES:
00240    use shr_strdata_mod
00241    use shr_dmodel_mod    ! shr data model stuff
00242    use mct_mod
00243    implicit none
00244 
00245 ! !INPUT/OUTPUT PARAMETERS:
00246 
00247    real(R8),                     intent(in)  :: scmlon,scmlat ! single column lat lon
00248    integer(IN),                  intent(in)  :: ocn_compid   ! id for ocean model  
00249    integer(IN),                  intent(in)  :: ocn_mpicom   ! mpi communicator for ocean  
00250    logical,            optional, intent(out) :: lnd_present  ! land point
00251    logical,            optional, intent(out) :: ice_present  ! ice point
00252    logical,            optional, intent(out) :: ocn_present  ! ocean point
00253 
00254 !EOP
00255 
00256    !----- local variables -----
00257    integer(IN)             :: rcode            ! error code
00258    integer(IN)             :: ncid_ocn         ! netcdf id for ocn_in
00259    integer(IN)             :: fracid           !  id for frac variable
00260    integer(IN)             :: closeLatIdx      ! index of returned lat point
00261    integer(IN)             :: closeLonIdx      ! index of returned lon point
00262    integer(IN)             :: unitn            ! io unit
00263    real   (R8)             :: ocn_frac(1,1)    ! ocean fraction
00264    real   (R8)             :: closeLat         ! returned close lat
00265    real   (R8)             :: closeLon         ! returned close lon
00266    character(len=CL)       :: nrevsn = ' '     ! full path restart file for branch
00267    character(len=CL)       :: rest_pfile = './rpointer.dom' ! restart pointer file
00268    character(len=CL)       :: bndtvs           ! sst file
00269    character(len=CL)       :: focndomain       ! ocn domain file
00270    logical                 :: sstcyc           ! flag for sst cycling
00271    logical                 :: docn_exists           ! flag if file exists locally
00272    logical                 :: ocn_exists            ! flag if file exists locally
00273    logical                 :: exists            ! flag if file exists locally
00274    logical                 :: aqua_planet      ! flags
00275    logical                 :: single_column    ! flags
00276 
00277    !----- formats -----
00278    character(*),parameter :: subname = "(shr_scam_checkSurface) "
00279    character(*),parameter :: F00   = "('(shr_scam_checkSurface) ',8a)" 
00280    type(shr_strdata_type) :: SDAT
00281    character(len=CL)      :: decomp = '1d' ! restart pointer file
00282    character(len=CL)      :: restfilm = 'unset' 
00283    character(len=CL)      :: restfils = 'unset'
00284    character(len=CL)      :: ocn_in = 'unset'
00285    integer(IN)   :: nfrac
00286    namelist /dom_inparm/ sstcyc, nrevsn, rest_pfile, bndtvs, focndomain
00287    namelist / docn_nml / ocn_in, decomp, restfilm, restfils
00288 
00289 !-------------------------------------------------------------------------------
00290 ! Notes:
00291 !-------------------------------------------------------------------------------
00292 
00293    inquire( file='ocn_in', exist=ocn_exists )
00294    inquire( file='docn_in', exist=docn_exists )
00295    if (ocn_exists) then
00296       !--- read in the ocn_in namelist to get name for focndomain file
00297 
00298       unitn = shr_file_getUnit() ! get an unused unit number
00299       open( unitn, file='ocn_in', status='old' )
00300       rcode = 1
00301       do while ( rcode /= 0 )
00302          read(unitn, dom_inparm, iostat=rcode)
00303          if (rcode < 0) then
00304             call shr_sys_abort( 'shr_scam_checkSurface encountered end-of-file on namelist read' )
00305          endif
00306       end do
00307       close( unitn )
00308       call shr_file_freeUnit(unitn)
00309 
00310       !--- open the netcdf file ---
00311 
00312       inquire(file=trim(focndomain),exist=exists)
00313       if (.not.exists) call shr_sys_abort(subName//"ERROR: file does not exist: "//trim(focndomain))
00314       rcode = nf90_open(focndomain,nf90_nowrite,ncid_ocn)
00315       if (rCode /= nf90_noerr) call shr_sys_abort(subName//"ERROR opening data file : "//trim(focndomain))
00316       if (s_loglev > 0) write(s_logunit,F00) 'opened netCDF data file: ',trim(focndomain)
00317 
00318       !--- Extract the fraction for current column ---
00319    
00320       call shr_scam_getCloseLatLon(ncid_ocn,scmlat,scmlon,closelat,closelon,closelatidx,closelonidx)
00321       rcode = nf90_inq_varid(ncid_ocn, 'frac', fracid)
00322       if (rcode /= nf90_noerr) then
00323          call shr_sys_abort(subname//"ERROR getting varid from variable frac in file "//trim(focndomain))
00324       end if
00325       rcode = nf90_get_var(ncid_ocn,fracid,ocn_frac,start=(/closelonidx,closelatidx/),count=(/1,1/))
00326       if (rcode /= nf90_noerr) then
00327          call shr_sys_abort(subname//"ERROR getting ocean fraction from "//trim(focndomain))
00328       end if
00329 
00330       !--- Set the appropriate surface flags based on ocean fraction.
00331    
00332       if ( present(ocn_present)      )                      ocn_present=(ocn_frac(1,1).gt.0.)
00333       if ( present(ocn_present).and.present(ice_present))   ice_present=ocn_present
00334       if ( present(lnd_present))                            lnd_present=(ocn_frac(1,1).lt.1.)
00335    else if (docn_exists) then
00336       !--- read in the ocn_in namelist to get name for focndomain file
00337 
00338       unitn = shr_file_getUnit() ! get an unused unit number
00339       open( unitn, file='docn_in', status='old' )
00340       rcode = 1
00341       do while ( rcode /= 0 )
00342          read (unitn,nml=docn_nml,iostat=rcode)
00343          if (rcode < 0) then
00344             call shr_sys_abort( 'shr_scam_checkSurface encountered end-of-file on namelist read' )
00345          endif
00346       end do
00347       close( unitn )
00348       call shr_file_freeUnit(unitn)
00349       call shr_strdata_readnml(SDAT,ocn_in)
00350       call shr_dmodel_readgrid(SDAT%grid,SDAT%gsmap,SDAT%nxg,SDAT%nyg, &
00351            SDAT%domainfile, ocn_compid, ocn_mpicom, '1d', readfrac=.true., &
00352            scmmode=.true.,scmlon=scmlon,scmlat=scmlat)
00353       nfrac = mct_aVect_indexRA(SDAT%grid%data,'frac')
00354       if ( present(ocn_present)      )                      ocn_present=(SDAT%grid%data%rAttr(nfrac,1).gt.0.)
00355       if ( present(ocn_present).and.present(ice_present))   ice_present=ocn_present
00356       if ( present(lnd_present))                            lnd_present=(SDAT%grid%data%rAttr(nfrac,1).lt.1.)
00357    else
00358    ! Exit early if no ocn component
00359       if ( present(ocn_present) ) ocn_present=.false.
00360       if ( present(ice_present) ) ice_present=.false.
00361       if ( present(lnd_present) ) lnd_present=.true.
00362    end if
00363 
00364 end subroutine shr_scam_checkSurface
00365 
00366 !===============================================================================
00367 
00368 end module shr_scam_mod
00369