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
40 include 'wrf_status_codes.h'
42 integer ,intent(in) :: DataHandle
43 character*(*) ,intent(in) :: Element
46 integer ,intent(out) :: Status
47 type(wrf_data_handle) ,pointer :: DH
50 integer ,allocatable :: Buffer(:)
53 call GetDH(DataHandle,DH,Status)
54 if(Status /= WRF_NO_ERR) then
56 'Warning Status = ',Status,' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
57 call wrf_debug ( WARN , msg)
60 ! Do nothing unless it is time to write time-independent domain metadata.
61 IF ( ncdpar_ok_to_put_dom_ti( DataHandle ) ) THEN
62 if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
63 Status = WRF_WARN_FILE_NOT_OPENED
65 'Warning FILE NOT OPENED in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
66 call wrf_debug ( WARN , msg)
67 elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
68 STATUS = WRF_WARN_WRITE_RONLY_FILE
70 'Warning WRITE READ ONLY FILE in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
71 call wrf_debug ( WARN , msg)
72 elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
74 allocate(Buffer(Count), STAT=stat)
76 Status = WRF_ERR_FATAL_ALLOCATION_ERROR
77 write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
78 call wrf_debug ( FATAL , msg)
88 stat = NF_ROUTINE (DH%NCID,NF_GLOBAL,Element,ARGS)
89 deallocate(Buffer, STAT=stat2)
91 Status = WRF_ERR_FATAL_DEALLOCATION_ERR
92 write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
93 call wrf_debug ( FATAL , msg)
97 stat = NF_ROUTINE (DH%NCID,NF_GLOBAL,Element,ARGS)
99 call netcdf_err(stat,Status)
100 if(Status /= WRF_NO_ERR) then
101 write(msg,*) 'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element
102 call wrf_debug ( WARN , msg)
105 elseif (DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE .OR. DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE) then
106 stat = NF_REDEF(DH%NCID)
107 call netcdf_err(stat,Status)
108 if(Status /= WRF_NO_ERR) then
110 'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element
111 call wrf_debug ( WARN , msg)
115 allocate(Buffer(Count), STAT=stat)
117 Status = WRF_ERR_FATAL_ALLOCATION_ERROR
119 'Fatal ALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
120 call wrf_debug ( FATAL , msg)
130 stat = NF_ROUTINE (DH%NCID,NF_GLOBAL,Element,ARGS)
131 deallocate(Buffer, STAT=stat2)
133 Status = WRF_ERR_FATAL_DEALLOCATION_ERR
135 'Fatal DEALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
136 call wrf_debug ( FATAL , msg)
140 stat = NF_ROUTINE (DH%NCID,NF_GLOBAL,Element,ARGS)
142 call netcdf_err(stat,Status)
143 if(Status /= WRF_NO_ERR) then
145 'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element
146 call wrf_debug ( WARN , msg)
149 stat = NF_ENDDEF(DH%NCID)
150 call netcdf_err(stat,Status)
151 if(Status /= WRF_NO_ERR) then
153 'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element
154 call wrf_debug ( WARN , msg)
158 Status = WRF_ERR_FATAL_BAD_FILE_STATUS
160 'Fatal error BAD FILE STATUS in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
161 call wrf_debug ( FATAL , msg)