!*------------------------------------------------------------------------------
!* 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
character*(*) ,intent(in) :: DateStr
character*(*) ,intent(in) :: Var
TYPE_DATA
TYPE_COUNT
integer ,intent(out) :: Status
type(wrf_data_handle) ,pointer :: DH
character (VarNameLen) :: VarName
character (40+len(Element)) :: Name
integer :: stat
integer :: stat2
integer ,allocatable :: Buffer(:)
integer :: i
integer :: VDims (2)
integer :: VStart(2)
integer :: VCount(2)
integer :: NVar
integer :: TimeIndex
integer :: NCID
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_FOR_READ) then
Status = WRF_WARN_WRITE_RONLY_FILE
write(msg,*) &
'Warning WRITE READ ONLY FILE in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
call wrf_debug ( WARN , msg)
elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
if(LENGTH < 1) then
Status = WRF_WARN_ZERO_LENGTH_PUT
return
endif
do NVar=1,MaxVars
if(DH%MDVarNames(NVar) == Name) then
Status = WRF_WARN_2DRYRUNS_1VARIABLE
return
elseif(DH%MDVarNames(NVar) == NO_NAME) then
DH%MDVarNames(NVar) = Name
exit
elseif(NVar == MaxVars) then
Status = WRF_WARN_TOO_MANY_VARIABLES
write(msg,*) &
'Warning TOO MANY VARIABLES in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
call wrf_debug ( WARN , msg)
return
endif
enddo
do i=1,MaxDims
if(DH%DimLengths(i) == LENGTH) then
exit
elseif(DH%DimLengths(i) == NO_DIM) then
stat = NF_DEF_DIM(NCID,DH%DimNames(i),LENGTH,DH%DimIDs(i))
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
DH%DimLengths(i) = LENGTH
exit
elseif(i == MaxDims) then
Status = WRF_WARN_TOO_MANY_DIMS
write(msg,*) &
'Warning TOO MANY DIMENSIONS in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
call wrf_debug ( WARN , msg)
return
endif
enddo
DH%MDVarDimLens(NVar) = LENGTH
VDims(1) = DH%DimIDs(i)
VDims(2) = DH%DimUnlimID
stat = NF_DEF_VAR(NCID,Name,NF_TYPE,2,VDims,DH%MDVarIDs(NVar))
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
elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
do NVar=1,MaxVars
if(DH%MDVarNames(NVar) == Name) then
exit
elseif(DH%MDVarNames(NVar) == NO_NAME) then
Status = WRF_WARN_MD_NF
write(msg,*) &
'Warning METADATA NOT FOUND in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
call wrf_debug ( WARN , msg)
return
elseif(NVar == MaxVars) then
Status = WRF_WARN_TOO_MANY_VARIABLES
write(msg,*) &
'Warning TOO MANY VARIABLES in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
call wrf_debug ( WARN , msg)
return
endif
enddo
if(LENGTH > DH%MDVarDimLens(NVar)) then
Status = WRF_WARN_COUNT_TOO_LONG
write(msg,*) &
'Warning COUNT TOO LONG in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
call wrf_debug ( WARN , msg)
return
elseif(LENGTH < 1) then
Status = WRF_WARN_ZERO_LENGTH_PUT
write(msg,*) &
'Warning ZERO LENGTH PUT in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
call wrf_debug ( WARN , msg)
return
endif
call GetTimeIndex('write',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
#ifdef LOG
allocate(Buffer(LENGTH), 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
do i=1,Count
if(data(i)) then
Buffer(i)=1
else
Buffer(i)=0
endif
enddo
stat = NF_ROUTINE (NCID,DH%MDVarIDs(NVar),VStart,VCount,Buffer)
deallocate(Buffer, STAT=stat2)
if(stat2/= 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
#else
stat = NF_ROUTINE (NCID,DH%MDVarIDs(NVar),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__,' Element ',Element
call wrf_debug ( WARN , msg)
return
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)
return
endif
return