source: trunk/WRF.COMMON/WRFV2/external/io_netcdf/ext_ncd_get_dom_ti.code

!*------------------------------------------------------------------------------
!*  Standard Disclaimer
!*
!*  Forecast Systems Laboratory
!*  NOAA/OAR/ERL/FSL
!*  325 Broadway
!*  Boulder, CO     80303
!*
!*  AVIATION DIVISION
!*  ADVANCED COMPUTING BRANCH
!*  SMS/NNT Version: 2.0.0 
!*
!*  This software and its documentation are in the public domain and
!*  are furnished "as is".  The United States government, its 
!*  instrumentalities, officers, employees, and agents make no 
!*  warranty, express or implied, as to the usefulness of the software 
!*  and documentation for any purpose.  They assume no 
!*  responsibility (1) for the use of the software and documentation; 
!*  or (2) to provide technical support to users.
!* 
!*  Permission to use, copy, modify, and distribute this software is
!*  hereby granted, provided that this disclaimer notice appears in 
!*  all copies.  All modifications to this software must be clearly
!*  documented, and are solely the responsibility of the agent making
!*  the modification.  If significant modifications or enhancements
!*  are made to this software, the SMS Development team
!*  (sms-info@fsl.noaa.gov) should be notified.
!*
!*----------------------------------------------------------------------------
!*
!*  WRF NetCDF I/O
!   Author:  Jacques Middlecoff jacquesm@fsl.noaa.gov
!*  Date:    October 6, 2000
!*
!*----------------------------------------------------------------------------

  use wrf_data
  use ext_ncd_support_routines
  implicit none
  include 'wrf_status_codes.h'
  include 'netcdf.inc'
  integer               ,intent(in)     :: DataHandle
  character*(*)         ,intent(in)     :: Element
  TYPE_DATA
  TYPE_COUNT
  TYPE_OUTCOUNT
  integer               ,intent(out)    :: Status
  type(wrf_data_handle) ,pointer        :: DH
  integer                               :: XType
  integer                               :: Len
  integer                               :: stat
  TYPE_BUFFER

  call GetDH(DataHandle,DH,Status)
  if(Status /= WRF_NO_ERR) then
    write(msg,*) &
'Warning Status = ',Status,' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
    call wrf_debug ( WARN , msg) 
    return
  endif
! Do nothing unless it is time to read time-independent domain metadata.  
IF ( ncd_ok_to_get_dom_ti( DataHandle ) ) THEN
  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
    Status = WRF_WARN_FILE_NOT_OPENED   
    write(msg,*) &
'Warning FILE NOT OPENED in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
    call wrf_debug ( WARN , msg)
  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
    Status = WRF_WARN_DRYRUN_READ   
    write(msg,*) &
'Warning DRYRUN READ in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
    call wrf_debug ( WARN , msg)
  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
    Status = WRF_WARN_READ_WONLY_FILE   
    write(msg,*) &
'Warning READ WRITE ONLY FILE in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
    call wrf_debug ( WARN , msg)
  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
    stat = NF_INQ_ATT(DH%NCID,NF_GLOBAL,Element, XType, Len)
    call netcdf_err(stat,Status)
    if(Status /= WRF_NO_ERR) then
      write(msg,*) &
'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element
      call wrf_debug ( WARN , msg)
      return
    endif
    if ( NF_TYPE == NF_DOUBLE .OR. NF_TYPE == NF_FLOAT ) then
      if( .NOT. ( XType==NF_FLOAT .OR. XType==NF_DOUBLE) ) then
        Status = WRF_WARN_TYPE_MISMATCH   
        write(msg,*) &
'Warning TYPE MISMATCH in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
        call wrf_debug ( WARN , msg)
        return
      endif
    else
      if( XType/=NF_TYPE) then
        Status = WRF_WARN_TYPE_MISMATCH  
        write(msg,*) &
'Warning TYPE MISMATCH in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
        call wrf_debug ( WARN , msg)
        return
      endif
    endif
    if(Len<=0) then
      Status = WRF_WARN_LENGTH_LESS_THAN_1  
      write(msg,*) &
'Warning LENGTH < 1 in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
      call wrf_debug ( WARN , msg)
      return
    endif
#ifndef CHAR_TYPE 
    allocate(Buffer(Len), STAT=stat)
    if(stat/= 0) then
      Status = WRF_ERR_FATAL_ALLOCATION_ERROR  
      write(msg,*) &
'Fatal ALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
      call wrf_debug ( FATAL , msg)
      return
    endif
    stat = NF_ROUTINE (DH%NCID,NF_GLOBAL,Element,Buffer)
#else
    Data = ''
    stat = NF_GET_ATT_TEXT(DH%NCID,NF_GLOBAL,Element,Data)
#endif
    call netcdf_err(stat,Status)
    if(Status /= WRF_NO_ERR) then
      write(msg,*) &
'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element
      call wrf_debug ( WARN , msg)
      return
    endif
#ifndef CHAR_TYPE 
    COPY
    deallocate(Buffer, STAT=stat)
    if(stat/= WRF_NO_ERR) then
      Status = WRF_ERR_FATAL_DEALLOCATION_ERR 
      write(msg,*) &
'Fatal DEALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
      call wrf_debug ( FATAL , msg)
      return
    endif
    if(Len > Count) then
      OutCount = Count
      Status = WRF_WARN_MORE_DATA_IN_FILE  
    else
      OutCount = Len
      Status = WRF_NO_ERR
    endif
#endif
  else
    Status = WRF_ERR_FATAL_BAD_FILE_STATUS  
    write(msg,*) &
'Fatal error BAD FILE STATUS in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
    call wrf_debug ( FATAL , msg)
  endif
ENDIF
  return