1 !*------------------------------------------------------------------------------
4 !* Forecast Systems Laboratory
10 !* ADVANCED COMPUTING BRANCH
11 !* SMS/NNT Version: 2.0.0
13 !* This software and its documentation are in the public domain and
14 !* are furnished "as is". The United States government, its
15 !* instrumentalities, officers, employees, and agents make no
16 !* warranty, express or implied, as to the usefulness of the software
17 !* and documentation for any purpose. They assume no
18 !* responsibility (1) for the use of the software and documentation;
19 !* or (2) to provide technical support to users.
21 !* Permission to use, copy, modify, and distribute this software is
22 !* hereby granted, provided that this disclaimer notice appears in
23 !* all copies. All modifications to this software must be clearly
24 !* documented, and are solely the responsibility of the agent making
25 !* the modification. If significant modifications or enhancements
26 !* are made to this software, the SMS Development team
27 !* (sms-info@fsl.noaa.gov) should be notified.
29 !*----------------------------------------------------------------------------
32 ! Author: Jacques Middlecoff jacquesm@fsl.noaa.gov
33 !* Date: October 6, 2000
35 !*----------------------------------------------------------------------------
38 use ext_ncdpar_support_routines
41 include 'wrf_status_codes.h'
42 integer ,intent(in) :: DataHandle
43 character*(*) ,intent(in) :: Element
44 character (DateStrLen),intent(in) :: DateStr
45 character*(*) ,intent(in) :: Var
49 integer ,intent(out) :: Status
50 type(wrf_data_handle) ,pointer :: DH
51 character (VarNameLen) :: VarName
52 character (40+len(Element)) :: Name
53 character (40+len(Element)) :: FName
55 TYPE_BUFFER ,allocatable :: Buffer(:)
71 Status = WRF_WARN_ZERO_LENGTH_GET
73 'Warning ZERO LENGTH GET in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
74 call wrf_debug ( WARN , msg)
78 call DateCheck(DateStr,Status)
79 if(Status /= WRF_NO_ERR) then
81 'Warning DATE STRING ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
82 call wrf_debug ( WARN , msg)
85 call GetDH(DataHandle,DH,Status)
86 if(Status /= WRF_NO_ERR) then
88 'Warning Status = ',Status,' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
89 call wrf_debug ( WARN , msg)
93 call GetName(Element, VarName, Name, Status)
94 if(Status /= WRF_NO_ERR) then
96 'Warning Status = ',Status,' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
97 call wrf_debug ( WARN , msg)
100 if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
101 Status = WRF_WARN_FILE_NOT_OPENED
103 'Warning FILE NOT OPENED in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
104 call wrf_debug ( WARN , msg)
105 elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
106 Status = WRF_WARN_DRYRUN_READ
108 'Warning DRYRUN READ in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
109 call wrf_debug ( WARN , msg)
110 elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
111 Status = WRF_WARN_READ_WONLY_FILE
113 'Warning READ WONLY FILE in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
114 call wrf_debug ( WARN , msg)
115 elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
116 stat = NF_INQ_VARID(NCID,Name,VarID)
117 call netcdf_err(stat,Status)
118 if(Status /= WRF_NO_ERR) then
120 'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element
121 call wrf_debug ( WARN , msg)
124 stat = NF_INQ_VAR(NCID,VarID,FName,XType,NDims,DimIDs,NAtts)
125 call netcdf_err(stat,Status)
126 if(Status /= WRF_NO_ERR) then
128 'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element
129 call wrf_debug ( WARN , msg)
132 if ( NF_TYPE == NF_DOUBLE .OR. NF_TYPE == NF_FLOAT ) then
133 if( .NOT. ( XType==NF_FLOAT .OR. XType==NF_DOUBLE) ) then
134 Status = WRF_WARN_TYPE_MISMATCH
136 'Warning TYPE MISMATCH in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
137 call wrf_debug ( WARN , msg)
141 if(XType /= NF_TYPE) then
142 Status = WRF_WARN_TYPE_MISMATCH
144 'Warning TYPE MISMATCH in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
145 call wrf_debug ( WARN , msg)
149 if(NDims /= NMDVarDims) then
150 Status = WRF_ERR_FATAL_MDVAR_DIM_NOT_1D
152 'Fatal MDVAR DIM NOT 1D in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
153 call wrf_debug ( FATAL , msg)
156 stat = NF_INQ_DIMLEN(NCID,DimIDs(1),Len1)
157 call netcdf_err(stat,Status)
158 if(Status /= WRF_NO_ERR) then
160 'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' DimIDs(1) ',DimIDs(1)
161 call wrf_debug ( WARN , msg)
164 call GetTimeIndex('read',DataHandle,DateStr,TimeIndex,Status)
165 if(Status /= WRF_NO_ERR) then
167 'Warning in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
168 call wrf_debug ( WARN , msg)
172 VStart(2) = TimeIndex
176 allocate(Buffer(VCount(1)), STAT=stat)
178 Status = WRF_ERR_FATAL_ALLOCATION_ERROR
180 'Fatal ALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
181 call wrf_debug ( FATAL , msg)
184 stat = NF_VAR_PAR_ACCESS(ncid,DH%MDVarIDs(NVar),DH%ind_or_collective)
185 stat = NF_ROUTINE (NCID,VarID,VStart,VCount,Buffer)
187 if(Len1 > len(Data)) then
188 Status = WRF_WARN_CHARSTR_GT_LENDATA
190 'Warning LEN CHAR STRING > LEN DATA in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
191 call wrf_debug ( WARN , msg)
195 stat = NF_GET_VARA_TEXT (NCID,VarID,VStart,VCount,Data)
197 call netcdf_err(stat,Status)
198 if(Status /= WRF_NO_ERR) then
200 'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
201 call wrf_debug ( WARN , msg)
206 deallocate(Buffer, STAT=stat)
208 Status = WRF_ERR_FATAL_DEALLOCATION_ERR
210 'Fatal DEALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
211 call wrf_debug ( FATAL , msg)
214 if(Len1 > Count) then
216 Status = WRF_WARN_MORE_DATA_IN_FILE
223 Status = WRF_ERR_FATAL_BAD_FILE_STATUS
225 'Fatal error BAD FILE STATUS in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
226 call wrf_debug ( FATAL , msg)