!*------------------------------------------------------------------------------
!* 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 'netcdf.inc'
include 'wrf_status_codes.h'
integer ,intent(in) :: DataHandle
character*(*) ,intent(in) :: Element
character (DateStrLen),intent(in) :: DateStr
character*(*) ,intent(in) :: Var
TYPE_DATA
TYPE_COUNT
TYPE_OUTCOUNT
integer ,intent(out) :: Status
type(wrf_data_handle) ,pointer :: DH
character (VarNameLen) :: VarName
character (40+len(Element)) :: Name
character (40+len(Element)) :: FName
integer :: stat
TYPE_BUFFER ,allocatable :: Buffer(:)
integer :: i
integer :: VDims (2)
integer :: VStart(2)
integer :: VCount(2)
integer :: NVar
integer :: TimeIndex
integer :: NCID
integer :: DimIDs(2)
integer :: VarID
integer :: XType
integer :: NDims
integer :: NAtts
integer :: Len1
if(Count <= 0) then
Status = WRF_WARN_ZERO_LENGTH_GET
write(msg,*) &
'Warning ZERO LENGTH GET in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
call wrf_debug ( WARN , msg)
return
endif
VarName = Var
call DateCheck(DateStr,Status)
if(Status /= WRF_NO_ERR) then
write(msg,*) &
'Warning DATE STRING ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
call wrf_debug ( WARN , msg)
return
endif
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
NCID = DH%NCID
call GetName(Element, VarName, Name, 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
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 WONLY FILE in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
call wrf_debug ( WARN , msg)
elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
stat = NF_INQ_VARID(NCID,Name,VarID)
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
stat = NF_INQ_VAR(NCID,VarID,FName,XType,NDims,DimIDs,NAtts)
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(NDims /= NMDVarDims) then
Status = WRF_ERR_FATAL_MDVAR_DIM_NOT_1D
write(msg,*) &
'Fatal MDVAR DIM NOT 1D in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
call wrf_debug ( FATAL , msg)
return
endif
stat = NF_INQ_DIMLEN(NCID,DimIDs(1),Len1)
call netcdf_err(stat,Status)
if(Status /= WRF_NO_ERR) then
write(msg,*) &
'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' DimIDs(1) ',DimIDs(1)
call wrf_debug ( WARN , msg)
return
endif
call GetTimeIndex('read',DataHandle,DateStr,TimeIndex,Status)
if(Status /= WRF_NO_ERR) then
write(msg,*) &
'Warning in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
call wrf_debug ( WARN , msg)
return
endif
VStart(1) = 1
VStart(2) = TimeIndex
VCount(1) = LENGTH
VCount(2) = 1
#ifndef CHAR_TYPE
allocate(Buffer(VCount(1)), 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 (NCID,VarID,VStart,VCount,Buffer)
#else
if(Len1 > len(Data)) then
Status = WRF_WARN_CHARSTR_GT_LENDATA
write(msg,*) &
'Warning LEN CHAR STRING > LEN DATA in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
call wrf_debug ( WARN , msg)
return
endif
Data = ''
stat = NF_GET_VARA_TEXT (NCID,VarID,VStart,VCount,Data)
#endif
call netcdf_err(stat,Status)
if(Status /= WRF_NO_ERR) then
write(msg,*) &
'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
call wrf_debug ( WARN , msg)
return
endif
#ifndef CHAR_TYPE
COPY
deallocate(Buffer, STAT=stat)
if(stat/= 0) 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(Len1 > Count) then
OutCount = Count
Status = WRF_WARN_MORE_DATA_IN_FILE
else
OutCount = Len1
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
return