| blob | 30e95405268b40ebcb72a069b777160dd8192401 |
1 program convert_etoc
2 !--------------------Documentation Block----------------------------
3 !
4 ! Author : Sujata Pattanayak, CAS, IIT Delhi, India
6 ! Date : 20th May, 2008 ; Modified : 15 August 2008
8 ! This is the main program for the grid conversion purpose
9 ! which is essential to initialize WRF-NMM with WRF-Var.
10 ! This program reads an "wrfinput_d01" file from WRF-NMM (E-grid)
11 ! and write a new NetCDF file "wrfoutput_d01" in C-grid.
13 ! This program calls several subroutines.
14 ! Subroutines Included :
15 ! 1) get_dims_cdf : Used to get the dimension of any variable.
16 ! 2) get_var_0d_real_cdf : Used to get single valued variable.
17 ! 3) put_var_0d_real_cdf : Used to put single valued variable.
18 ! 4) get_var_1d_real_cdf : Used to get one dimensional variable.
19 ! 5) put_var_1d_real_cdf : Used to put one dimensional variable.
20 ! 6) get_var_2d_real_cdf : Used to get two dimensional variable.
21 ! 7) put_var_2d_real_cdf : Used to put two dimensional variable.
22 ! 8) get_var_3d_real_cdf : Used to get three dimensional variable.
23 ! 9) put_var_3d_real_cdf : Used to put three dimensional variable.
24 ! 10) get_var_2d_int_cdf : Used to get two dimensional integer variable.
25 ! 11) put_var_2d_int_cdf : Used to put twodimensional integer variable.
26 ! 12) fill_nmm_grid2 : Used to generate two dimensional A-grid structure.
27 ! 13) fill_nmm_grid3 : Used to generate three dimensional A-grid structure.
28 ! 14) fill_arw_ugrid : Used to generate 3D staggered west-east points (U component).
29 ! 15) fill_arw_vgrid : Used to generate 3D staggered south-north points (V component).
30 ! 16) fill_arw_xllu_grid : Used to generate 2D staggered west-east point.
31 ! 17) fill_arw_xllv_grid : Used to generate 2D staggered south-north point.
33 !-------------------------------------------------------------------
35 implicit none
37 include 'netcdf.inc'
39 integer cdfid, rcode
40 integer uid, vid, wid, tid, qvaporid, qcloudid, qrainid, qiceid, smoisid, tslbid
41 integer u10id, v10id, t2id, q2id, psfcid, muid, mapfac_mxid, mapfac_uxid, mapfac_vxid
42 integer znuid, znwid, ptopid, cf1id, cf2id, timesid, mu0id
43 integer hgtid, tskid, sstid, co_fid, tmnid, xlatid, xlongid, xlat_uid, xlong_uid, xlat_vid, xlong_vid
44 integer snowcid, lu_indexid, landmaskid, xlandid, seaiceid, ivgtypid, isltypid, vegfraid, snowhid
45 integer latid, lonid, timid, levid, lev_stagid, dateid, lon_stagid, lat_stagid, soil_layerid
46 character (len=100):: wrfinput_d01, &
47 wrfoutput_d01
48 character(len=512) :: input_file, &
49 output_file
50 integer, parameter :: max_variables = 25
51 real, parameter :: dellat = 0.1725
52 character(len=20) :: var(max_variables)
53 logical :: debug
54 integer :: ids, ide, jds, jde, kds, kde
55 integer :: ndims
56 integer :: value
57 integer :: id_data, istart, iend
58 integer :: i1, i2, i3, time
59 integer :: i,j,k
60 integer :: nx, ny, nz, nnx, nny, nnz, nnux, nnuy, nnvx, nnvy, nnmx, nnmy, nnnx, nnny, nnnz
61 real :: data, ptop
62 real :: PI_2, D2R, R2D
63 real, parameter :: ERAD=6371200.
64 real, parameter :: dx=0.1725, dy=0.1725
65 real, parameter :: PDTOP= 38424.47
66 real, parameter :: PI = 3.1415926
67 integer, parameter :: TDIMS =2
68 integer TSTART(TDIMS), TCOUNT(TDIMS)
69 real :: dx_meter, dy_meter
70 integer, dimension (4) :: dims
71 real, allocatable, dimension(:,:,:) :: u_e, v_e, w_e, t_e, q_e
72 real, allocatable, dimension(:,:,:) :: u_a, v_a, w_a, t_a, q_a
73 real, allocatable, dimension(:,:,:) :: u_c, v_c
74 real, allocatable, dimension(:,:,:) :: smc_e, stc_e
75 real, allocatable, dimension(:,:,:) :: smc_a, stc_a
76 real, allocatable, dimension(:,:) :: pd_e, glat_e, glon_e, fis_e
77 real, allocatable, dimension(:,:) :: pd_a, glat_a, glon_a, fis_a, mu_a
78 real, allocatable, dimension(:,:) :: clat_e, mapfac_ux_e, mapfac_vx_e, mapfac_mx_e
79 real, allocatable, dimension(:,:) :: clat_a, mapfac_ux_a, mapfac_vx_a, mapfac_mx_a
80 real, allocatable, dimension(:,:) :: mapfac_ux_c, mapfac_vx_c
81 real, allocatable, dimension(:,:) :: xlat_u_c, xlong_u_c, xlat_v_c, xlong_v_c
82 real, allocatable, dimension(:,:) :: u10_e, v10_e, t2_e, qs_e, dx_nmm_e, tsk_e, sst_e, co_f_e
83 real, allocatable, dimension(:,:) :: u10_a, v10_a, t2_a, qs_a, dx_nmm_a, tsk_a, sst_a, co_f_a
84 real, allocatable, dimension(:,:) :: soiltb_e, acsnow_e, lu_index_e, landmask_e, seaice_e, ivgtyp_e
85 real, allocatable, dimension(:,:) :: soiltb_a, acsnow_a, lu_index_a, landmask_a, seaice_a, ivgtyp_a
86 real, allocatable, dimension(:,:) :: isltyp_e, vegfra_e, snowh_e
87 real, allocatable, dimension(:,:) :: isltyp_a, vegfra_a, snowh_a
88 real, allocatable, dimension(:) :: eta1, eta2
89 integer :: datestrlen, ew, sn, bt, bt_s, ew_s, sn_s, soil_layer
90 integer :: diff_opt, km_opt, damp_opt, mp_physics, ra_lw_physics, ra_sw_physics, sst_update, map_proj
91 integer :: sf_sfclay_physics, sf_surface_physics, bl_pbl_physics, cu_physics, surface_input_source
92 real :: khdif, kvdif, dt, cen_lat, cen_lon, truelat1, truelat2, mode_cen_lat, stand_lon
93 character(len=30) :: FCST_TIME, START_DATE, SIM_START_DATE
95 call getarg( 1, FCST_TIME )
96 call getarg( 2, START_DATE)
97 call getarg( 3, SIM_START_DATE)
99 TSTART(1) =1
100 TSTART(2) =1
101 TCOUNT(1) =19
102 TCOUNT(2) =1
104 !-----------------------------------------------------------------
105 !Define dimension of the "OUTPUT" NetCDF file and specify the
106 !values for the global attributes.
107 !-----------------------------------------------------------------
108 time = 1
109 datestrlen = 19
110 ew = 697
111 sn = 429
112 bt = 50
113 bt_s = 51
114 ew_s = 698
115 sn_s = 430
116 soil_layer = 5
118 diff_opt =1
119 km_opt =1
120 damp_opt =1
121 mp_physics =5
122 ra_lw_physics =99
123 ra_sw_physics =99
124 sf_sfclay_physics =2
125 sf_surface_physics =2
126 bl_pbl_physics =2
127 cu_physics =2
128 surface_input_source =1
129 sst_update =0
130 map_proj =6
131 khdif =0.
132 kvdif =0.
133 dt =60.
134 cen_lat =21.5
135 cen_lon =78.
136 truelat1 =1.e+20
137 truelat2 =1.e+20
138 mode_cen_lat =21.5
139 stand_lon =-78.
141 input_file = 'wrfinput_d01'
142 output_file = 'wrfoutput_d01'
143 !-----------------------------------------------------------------
144 PI_2 = ACOS(0.)
145 D2R = PI_2/90.
146 R2D = 1./D2R
147 dx_meter = D2R*ERAD*dx
148 dy_meter = D2R*ERAD*dy
150 !-----------------------------------------------------------------
151 !Creating a New NetCDF file and define the dimensions and attributes
152 !-----------------------------------------------------------------
153 cdfid = nccre(output_file, NCCLOB, rcode)
155 !------Dimensions--------
157 timid = ncddef(cdfid, 'Time', time, rcode)
158 dateid = ncddef(cdfid, 'DateStrLen1', datestrlen, rcode)
159 lonid = ncddef(cdfid, 'west_east', ew, rcode)
160 latid = ncddef(cdfid, 'south_north', sn, rcode)
161 levid = ncddef(cdfid, 'bottom_top', bt, rcode)
162 lev_stagid = ncddef(cdfid, 'bottom_top_stag', bt_s, rcode)
163 lon_stagid = ncddef(cdfid, 'west_east_stag', ew_s, rcode)
164 lat_stagid = ncddef(cdfid, 'south_north_stag', sn_s, rcode)
165 soil_layerid = ncddef(cdfid, 'soil_layers_stag', soil_layer, rcode)
167 !------define additional variable----------------------------------
169 timesid= ncvdef(cdfid, 'Times', ncchar, 2,(/ dateid, timid /),rcode)
170 uid= ncvdef(cdfid, 'U', ncfloat, 4,(/ lon_stagid, latid, levid, timid /),rcode)
171 vid= ncvdef(cdfid, 'V', ncfloat, 4,(/ lonid, lat_stagid, levid, timid /),rcode)
172 wid= ncvdef(cdfid, 'W', ncfloat, 4,(/ lonid, latid, lev_stagid, timid /),rcode)
173 tid= ncvdef(cdfid, 'T', ncfloat, 4,(/ lonid, latid, levid, timid /),rcode)
174 qvaporid= ncvdef(cdfid, 'QVAPOR', ncfloat, 4,(/ lonid, latid, levid, timid /),rcode)
175 qcloudid= ncvdef(cdfid, 'QCLOUD', ncfloat, 4,(/ lonid, latid, levid, timid /),rcode)
176 qrainid= ncvdef(cdfid, 'QRAIN', ncfloat, 4,(/ lonid, latid, levid, timid /),rcode)
177 qiceid= ncvdef(cdfid, 'QICE', ncfloat, 4,(/ lonid, latid, levid, timid /),rcode)
178 u10id= ncvdef(cdfid, 'U10', ncfloat, 3,(/ lonid, latid, timid /),rcode)
179 v10id= ncvdef(cdfid, 'V10', ncfloat, 3,(/ lonid, latid, timid /),rcode)
180 t2id= ncvdef(cdfid, 'T2', ncfloat, 3,(/ lonid, latid, timid /),rcode)
181 q2id= ncvdef(cdfid, 'Q2', ncfloat, 3,(/ lonid, latid, timid /),rcode)
182 psfcid= ncvdef(cdfid, 'PSFC', ncfloat, 3,(/ lonid, latid, timid /),rcode)
183 muid= ncvdef(cdfid, 'MU', ncfloat, 3,(/ lonid, latid, timid /),rcode)
184 znuid= ncvdef(cdfid, 'ZNU', ncfloat, 2,(/ levid, timid /),rcode)
185 znwid= ncvdef(cdfid, 'ZNW', ncfloat, 2,(/ lev_stagid, timid /),rcode)
186 ptopid= ncvdef(cdfid, 'P_TOP', ncfloat, 1,(/ timid /),rcode)
187 mapfac_uxid= ncvdef(cdfid, 'MAPFAC_UX', ncfloat, 3,(/ lon_stagid, latid, timid /),rcode)
188 mapfac_vxid= ncvdef(cdfid, 'MAPFAC_VX', ncfloat, 3,(/ lonid, lat_stagid, timid /),rcode)
189 mapfac_mxid= ncvdef(cdfid, 'MAPFAC_MX', ncfloat, 3,(/ lonid, latid, timid /),rcode)
190 mu0id= ncvdef(cdfid, 'MU0', ncfloat, 3,(/ lonid, latid, timid /),rcode)
191 cf1id= ncvdef(cdfid, 'CF1', ncfloat, 1,(/ timid /),rcode)
192 cf2id= ncvdef(cdfid, 'CF2', ncfloat, 1,(/ timid /),rcode)
193 hgtid= ncvdef(cdfid, 'HGT', ncfloat, 3,(/ lonid, latid, timid /),rcode)
194 tskid= ncvdef(cdfid, 'TSK', ncfloat, 3,(/ lonid, latid, timid /),rcode)
195 sstid= ncvdef(cdfid, 'SST', ncfloat, 3,(/ lonid, latid, timid /),rcode)
196 co_fid= ncvdef(cdfid, 'F', ncfloat, 3,(/ lonid, latid, timid /),rcode)
197 tmnid= ncvdef(cdfid, 'TMN', ncfloat, 3,(/ lonid, latid, timid /),rcode)
198 xlatid= ncvdef(cdfid, 'XLAT', ncfloat, 3,(/ lonid, latid, timid /),rcode)
199 xlongid= ncvdef(cdfid, 'XLONG', ncfloat, 3,(/ lonid, latid, timid /),rcode)
200 xlat_uid= ncvdef(cdfid, 'XLAT_U', ncfloat, 3,(/ lon_stagid, latid, timid /),rcode)
201 xlong_uid= ncvdef(cdfid, 'XLONG_U', ncfloat, 3,(/ lon_stagid, latid, timid /),rcode)
202 xlat_vid= ncvdef(cdfid, 'XLAT_V', ncfloat, 3,(/ lonid, lat_stagid, timid /),rcode)
203 xlong_vid= ncvdef(cdfid, 'XLONG_V', ncfloat, 3,(/ lonid, lat_stagid, timid /),rcode)
204 snowcid= ncvdef(cdfid, 'SNOWC', ncfloat, 3,(/ lonid, latid, timid /),rcode)
205 lu_indexid= ncvdef(cdfid, 'LU_INDEX', ncfloat, 3,(/ lonid, latid, timid /),rcode)
206 landmaskid= ncvdef(cdfid, 'LANDMASK', ncfloat, 3,(/ lonid, latid, timid /),rcode)
207 xlandid= ncvdef(cdfid, 'XLAND', ncfloat, 3,(/ lonid, latid, timid /),rcode)
208 smoisid= ncvdef(cdfid, 'SMOIS', ncfloat, 4,(/ lonid, latid, soil_layerid, timid /),rcode)
209 tslbid= ncvdef(cdfid, 'TSLB', ncfloat, 4,(/ lonid, latid, soil_layerid, timid /),rcode)
210 seaiceid= ncvdef(cdfid, 'SEAICE', ncfloat, 3,(/ lonid, latid, timid /),rcode)
211 ivgtypid= ncvdef(cdfid, 'IVGTYP', nclong, 3,(/ lonid, latid, timid /),rcode)
212 isltypid= ncvdef(cdfid, 'ISLTYP', nclong, 3,(/ lonid, latid, timid /),rcode)
213 vegfraid= ncvdef(cdfid, 'VEGFRA', ncfloat, 3,(/ lonid, latid, timid /),rcode)
214 snowhid= ncvdef(cdfid, 'SNOWH', ncfloat, 3,(/ lonid, latid, timid /),rcode)
216 !------Attributes for U -----------------------------------------
217 call ncapt(cdfid,uid,'FieldType',NCLONG, 1,104, rcode)
218 call ncaptc(cdfid,uid,'MemoryOrder',NCCHAR, 3,'XYZ' , rcode)
219 call ncaptc(cdfid,uid,'description',NCCHAR,16,'x-wind component',rcode)
220 call ncaptc(cdfid,uid,'units',NCCHAR,5,'m s-1',rcode)
221 call ncaptc(cdfid,uid,'stagger',NCCHAR,1,'X',rcode)
222 call ncaptc(cdfid,uid,'coordinates',NCCHAR,14,'XLONG_U XLAT_U',rcode)
223 !------Attributes for V -----------------------------------------
224 call ncapt(cdfid,vid,'FieldType',NCLONG, 1,104, rcode)
225 call ncaptc(cdfid,vid,'MemoryOrder',NCCHAR, 3,'XYZ' , rcode)
226 call ncaptc(cdfid,vid,'description',NCCHAR,16,'y-wind component',rcode)
227 call ncaptc(cdfid,vid,'units',NCCHAR,5,'m s-1',rcode)
228 call ncaptc(cdfid,vid,'stagger',NCCHAR,1,'Y',rcode)
229 call ncaptc(cdfid,vid,'coordinates',NCCHAR,14,'XLONG_V XLAT_V',rcode)
230 !------Attributes for W -----------------------------------------
231 call ncapt(cdfid,wid,'FieldType',NCLONG, 1,104, rcode)
232 call ncaptc(cdfid,wid,'MemoryOrder',NCCHAR, 3,'XYZ' , rcode)
233 call ncaptc(cdfid,wid,'description',NCCHAR,16,'z-wind component',rcode)
234 call ncaptc(cdfid,wid,'units',NCCHAR,5,'m s-1',rcode)
235 call ncaptc(cdfid,wid,'stagger',NCCHAR,1,'Z',rcode)
236 call ncaptc(cdfid,wid,'coordinates',NCCHAR,10,'XLONG XLAT',rcode)
237 !------Attributes for T -----------------------------------------
238 call ncapt(cdfid,tid,'FieldType',NCLONG, 1,104, rcode)
239 call ncaptc(cdfid,tid,'MemoryOrder',NCCHAR, 3,'XYZ' , rcode)
240 call ncaptc(cdfid,tid,'description',NCCHAR,20,'Sensible temperature',rcode)
241 call ncaptc(cdfid,tid,'units',NCCHAR,1,'K',rcode)
242 call ncaptc(cdfid,tid,'stagger',NCCHAR,0,'',rcode)
243 call ncaptc(cdfid,tid,'coordinates',NCCHAR,10,'XLONG XLAT',rcode)
244 !------Attributes for QVAPOR-------------------------------------
245 call ncapt(cdfid,qvaporid,'FieldType',NCLONG, 1,104, rcode)
246 call ncaptc(cdfid,qvaporid,'MemoryOrder',NCCHAR, 3,'XYZ' , rcode)
247 call ncaptc(cdfid,qvaporid,'description',NCCHAR,20,'Specific humidity',rcode)
248 call ncaptc(cdfid,qvaporid,'units',NCCHAR,7,'kg kg-1',rcode)
249 call ncaptc(cdfid,qvaporid,'stagger',NCCHAR,0,'',rcode)
250 call ncaptc(cdfid,qvaporid,'coordinates',NCCHAR,10,'XLONG XLAT',rcode)
251 !------Attributes for QCLOUD-------------------------------------
252 call ncapt(cdfid,qcloudid,'FieldType',NCLONG, 1,104, rcode)
253 call ncaptc(cdfid,qcloudid,'MemoryOrder',NCCHAR, 3,'XYZ' , rcode)
254 call ncaptc(cdfid,qcloudid,'description',NCCHAR,24,'Cloud water mixing ratio',rcode)
255 call ncaptc(cdfid,qcloudid,'units',NCCHAR,7,'kg kg-1',rcode)
256 call ncaptc(cdfid,qcloudid,'stagger',NCCHAR,0,'',rcode)
257 call ncaptc(cdfid,qcloudid,'coordinates',NCCHAR,10,'XLONG XLAT',rcode)
258 !------Attributes for QRAIN--------------------------------------
259 call ncapt(cdfid,qrainid,'FieldType',NCLONG, 1,104, rcode)
260 call ncaptc(cdfid,qrainid,'MemoryOrder',NCCHAR, 3,'XYZ' , rcode)
261 call ncaptc(cdfid,qrainid,'description',NCCHAR,23,'Rain water mixing ratio',rcode)
262 call ncaptc(cdfid,qrainid,'units',NCCHAR,7,'kg kg-1',rcode)
263 call ncaptc(cdfid,qrainid,'stagger',NCCHAR,0,'',rcode)
264 call ncaptc(cdfid,qrainid,'coordinates',NCCHAR,10,'XLONG XLAT',rcode)
265 !------Attributes for QICE--------------------------------------
266 call ncapt(cdfid,qiceid,'FieldType',NCLONG, 1,104, rcode)
267 call ncaptc(cdfid,qiceid,'MemoryOrder',NCCHAR, 3,'XYZ' , rcode)
268 call ncaptc(cdfid,qiceid,'description',NCCHAR,16,'Ice mixing ratio',rcode)
269 call ncaptc(cdfid,qiceid,'units',NCCHAR,7,'kg kg-1',rcode)
270 call ncaptc(cdfid,qiceid,'stagger',NCCHAR,0,'',rcode)
271 call ncaptc(cdfid,qiceid,'coordinates',NCCHAR,10,'XLONG XLAT',rcode)
272 !------Attributes for U10----------------------------------------
273 call ncapt(cdfid,u10id,'FieldType',NCLONG, 1,104, rcode)
274 call ncaptc(cdfid,u10id,'MemoryOrder',NCCHAR, 2,'XY' , rcode)
275 call ncaptc(cdfid,u10id,'description',NCCHAR,9,'U at 10 M',rcode)
276 call ncaptc(cdfid,u10id,'units',NCCHAR,5,'m s-1',rcode)
277 call ncaptc(cdfid,u10id,'stagger',NCCHAR,0,'',rcode)
278 call ncaptc(cdfid,u10id,'coordinates',NCCHAR,10,'XLONG XLAT',rcode)
279 !------Attributes for V10----------------------------------------
280 call ncapt(cdfid,v10id,'FieldType',NCLONG, 1,104, rcode)
281 call ncaptc(cdfid,v10id,'MemoryOrder',NCCHAR, 2,'XY' , rcode)
282 call ncaptc(cdfid,v10id,'description',NCCHAR,9,'V at 10 M',rcode)
283 call ncaptc(cdfid,v10id,'units',NCCHAR,5,'m s-1',rcode)
284 call ncaptc(cdfid,v10id,'stagger',NCCHAR,0,'',rcode)
285 call ncaptc(cdfid,v10id,'coordinates',NCCHAR,10,'XLONG XLAT',rcode)
286 !------Attributes for T2-----------------------------------------
287 call ncapt(cdfid,t2id,'FieldType',NCLONG, 1,104, rcode)
288 call ncaptc(cdfid,t2id,'MemoryOrder',NCCHAR, 2,'XY' , rcode)
289 call ncaptc(cdfid,t2id,'description',NCCHAR,11,'TEMP at 2 M',rcode)
290 call ncaptc(cdfid,t2id,'units',NCCHAR,1,'K',rcode)
291 call ncaptc(cdfid,t2id,'stagger',NCCHAR,0,'',rcode)
292 call ncaptc(cdfid,t2id,'coordinates',NCCHAR,10,'XLONG XLAT',rcode)
293 !------Attributes for Q2-----------------------------------------
294 call ncapt(cdfid,q2id,'FieldType',NCLONG, 1,104, rcode)
295 call ncaptc(cdfid,q2id,'MemoryOrder',NCCHAR, 2,'XY' , rcode)
296 call ncaptc(cdfid,q2id,'description',NCCHAR,8,'Q at 2 M',rcode)
297 call ncaptc(cdfid,q2id,'units',NCCHAR,7,'kg kg-1',rcode)
298 call ncaptc(cdfid,q2id,'stagger',NCCHAR,0,'',rcode)
299 call ncaptc(cdfid,q2id,'coordinates',NCCHAR,10,'XLONG XLAT',rcode)
300 !------Attributes for PSFC---------------------------------------
301 call ncapt(cdfid,psfcid,'FieldType',NCLONG, 1,104, rcode)
302 call ncaptc(cdfid,psfcid,'MemoryOrder',NCCHAR, 2,'XY' , rcode)
303 call ncaptc(cdfid,psfcid,'description',NCCHAR,20,'Mass in sigma domain',rcode)
304 call ncaptc(cdfid,psfcid,'units',NCCHAR,2,'Pa',rcode)
305 call ncaptc(cdfid,psfcid,'stagger',NCCHAR,0,'',rcode)
306 call ncaptc(cdfid,psfcid,'coordinates',NCCHAR,10,'XLONG XLAT',rcode)
307 !------Attributes for MU-----------------------------------------
308 call ncapt(cdfid,muid,'FieldType',NCLONG, 1,104, rcode)
309 call ncaptc(cdfid,muid,'MemoryOrder',NCCHAR, 2,'XY' , rcode)
310 call ncaptc(cdfid,muid,'description',NCCHAR,23,'Mass in pressure domain',rcode)
311 call ncaptc(cdfid,muid,'units',NCCHAR,2,'Pa',rcode)
312 call ncaptc(cdfid,muid,'stagger',NCCHAR,0,'',rcode)
313 call ncaptc(cdfid,muid,'coordinates',NCCHAR,10,'XLONG XLAT',rcode)
314 !------Attributes for ZNU----------------------------------------
315 call ncapt(cdfid,znuid,'FieldType',NCLONG, 1,104, rcode)
316 call ncaptc(cdfid,znuid,'MemoryOrder',NCCHAR, 1,'Z' , rcode)
317 call ncaptc(cdfid,znuid,'description',NCCHAR,21,'Sigma in sigma domain',rcode)
318 call ncaptc(cdfid,znuid,'units',NCCHAR,0,'',rcode)
319 call ncaptc(cdfid,znuid,'stagger',NCCHAR,0,'',rcode)
320 !------Attributes for ZNW----------------------------------------
321 call ncapt(cdfid,znwid,'FieldType',NCLONG, 1,104, rcode)
322 call ncaptc(cdfid,znwid,'MemoryOrder',NCCHAR, 1,'Z' , rcode)
323 call ncaptc(cdfid,znwid,'description',NCCHAR,24,'Sigma in pressure domain',rcode)
324 call ncaptc(cdfid,znwid,'units',NCCHAR,0,'',rcode)
325 call ncaptc(cdfid,znwid,'stagger',NCCHAR,0,'',rcode)
326 !------Attributes for P_TOP--------------------------------------
327 call ncapt(cdfid,ptopid,'FieldType',NCLONG, 1,104, rcode)
328 call ncaptc(cdfid,ptopid,'MemoryOrder',NCCHAR, 1,'0' , rcode)
329 call ncaptc(cdfid,ptopid,'description',NCCHAR,25,'pressure at top of domain',rcode)
330 call ncaptc(cdfid,ptopid,'units',NCCHAR,2,'Pa',rcode)
331 call ncaptc(cdfid,ptopid,'stagger',NCCHAR,0,'',rcode)
332 !------Attributes for MAPFAC_MX----------------------------------
333 call ncapt(cdfid,mapfac_mxid,'FieldType',NCLONG, 1,104, rcode)
334 call ncaptc(cdfid,mapfac_mxid,'MemoryOrder',NCCHAR, 2,'XY' , rcode)
335 call ncaptc(cdfid,mapfac_mxid,'description',NCCHAR,42,'Map scale factor on mass grid, x direction',rcode)
336 call ncaptc(cdfid,mapfac_mxid,'units',NCCHAR,0,'',rcode)
337 call ncaptc(cdfid,mapfac_mxid,'stagger',NCCHAR,0,'',rcode)
338 call ncaptc(cdfid,mapfac_mxid,'coordinates',NCCHAR,10,'XLONG XLAT',rcode)
339 !------Attributes for MAPFAC_UX----------------------------------
340 call ncapt(cdfid,mapfac_uxid,'FieldType',NCLONG, 1,104, rcode)
341 call ncaptc(cdfid,mapfac_uxid,'MemoryOrder',NCCHAR, 2,'XY' , rcode)
342 call ncaptc(cdfid,mapfac_uxid,'description',NCCHAR,39,'Map scale factor on u-grid, x direction',rcode)
343 call ncaptc(cdfid,mapfac_uxid,'units',NCCHAR,0,'',rcode)
344 call ncaptc(cdfid,mapfac_uxid,'stagger',NCCHAR,1,'X',rcode)
345 call ncaptc(cdfid,mapfac_uxid,'coordinates',NCCHAR,14,'XLONG_U XLAT_U',rcode)
346 !------Attributes for MAPFAC_VX----------------------------------
347 call ncapt(cdfid,mapfac_vxid,'FieldType',NCLONG, 1,104, rcode)
348 call ncaptc(cdfid,mapfac_vxid,'MemoryOrder',NCCHAR, 2,'XY' , rcode)
349 call ncaptc(cdfid,mapfac_vxid,'description',NCCHAR,39,'Map scale factor on v-grid, x direction',rcode)
350 call ncaptc(cdfid,mapfac_vxid,'units',NCCHAR,0,'',rcode)
351 call ncaptc(cdfid,mapfac_vxid,'stagger',NCCHAR,1,'Y',rcode)
352 call ncaptc(cdfid,mapfac_vxid,'coordinates',NCCHAR,14,'XLONG_V XLAT_V',rcode)
353 !------Attributes for MU0----------------------------------------
354 call ncapt(cdfid,mu0id,'FieldType',NCLONG, 1,104, rcode)
355 call ncaptc(cdfid,mu0id,'MemoryOrder',NCCHAR, 2,'XY' , rcode)
356 call ncaptc(cdfid,mu0id,'description',NCCHAR,18,'East-west distance',rcode)
357 call ncaptc(cdfid,mu0id,'units',NCCHAR,1,'m',rcode)
358 call ncaptc(cdfid,mu0id,'stagger',NCCHAR,0,'',rcode)
359 call ncaptc(cdfid,mu0id,'coordinates',NCCHAR,10,'XLONG XLAT',rcode)
360 !------Attributes for CF1----------------------------------------
361 call ncapt(cdfid,cf1id,'FieldType',NCLONG, 1,104, rcode)
362 call ncaptc(cdfid,cf1id,'MemoryOrder',NCCHAR, 1,'0' , rcode)
363 call ncaptc(cdfid,cf1id,'description',NCCHAR,18,'East-west distance',rcode)
364 call ncaptc(cdfid,cf1id,'units',NCCHAR,6,'degree',rcode)
365 call ncaptc(cdfid,cf1id,'stagger',NCCHAR,0,'',rcode)
366 !------Attributes for CF2----------------------------------------
367 call ncapt(cdfid,cf2id,'FieldType',NCLONG, 1,104, rcode)
368 call ncaptc(cdfid,cf2id,'MemoryOrder',NCCHAR, 1,'0' , rcode)
369 call ncaptc(cdfid,cf2id,'description',NCCHAR,20,'North-south distance',rcode)
370 call ncaptc(cdfid,cf2id,'units',NCCHAR,6,'degree',rcode)
371 call ncaptc(cdfid,cf2id,'stagger',NCCHAR,0,'',rcode)
372 !------Attributes for HGT----------------------------------------
373 call ncapt(cdfid,hgtid,'FieldType',NCLONG, 1,104, rcode)
374 call ncaptc(cdfid,hgtid,'MemoryOrder',NCCHAR, 2,'XY' , rcode)
375 call ncaptc(cdfid,hgtid,'description',NCCHAR,14,'Terrain height',rcode)
376 call ncaptc(cdfid,hgtid,'units',NCCHAR,1,'m',rcode)
377 call ncaptc(cdfid,hgtid,'stagger',NCCHAR,0,'',rcode)
378 call ncaptc(cdfid,hgtid,'coordinates',NCCHAR,10,'XLONG XLAT',rcode)
379 !------Attributes for TSK----------------------------------------
380 call ncapt(cdfid,tskid,'FieldType',NCLONG, 1,104, rcode)
381 call ncaptc(cdfid,tskid,'MemoryOrder',NCCHAR, 2,'XY' , rcode)
382 call ncaptc(cdfid,tskid,'description',NCCHAR,15,'Skin temprature',rcode)
383 call ncaptc(cdfid,tskid,'units',NCCHAR,1,'K',rcode)
384 call ncaptc(cdfid,tskid,'stagger',NCCHAR,0,'',rcode)
385 call ncaptc(cdfid,tskid,'coordinates',NCCHAR,10,'XLONG XLAT',rcode)
386 !------Attributes for SST----------------------------------------
387 call ncapt(cdfid,sstid,'FieldType',NCLONG, 1,104, rcode)
388 call ncaptc(cdfid,sstid,'MemoryOrder',NCCHAR, 2,'XY' , rcode)
389 call ncaptc(cdfid,sstid,'description',NCCHAR,15,'Skin temprature',rcode)
390 call ncaptc(cdfid,sstid,'units',NCCHAR,1,'K',rcode)
391 call ncaptc(cdfid,sstid,'stagger',NCCHAR,0,'',rcode)
392 call ncaptc(cdfid,sstid,'coordinates',NCCHAR,10,'XLONG XLAT',rcode)
393 !------Attributes for F------------------------------------------
394 call ncapt(cdfid,co_fid,'FieldType',NCLONG, 1,104, rcode)
395 call ncaptc(cdfid,co_fid,'MemoryOrder',NCCHAR, 2,'XY' , rcode)
396 call ncaptc(cdfid,co_fid,'description',NCCHAR,27,'Coriolis sine latitute term',rcode)
397 call ncaptc(cdfid,co_fid,'units',NCCHAR,3,'s-1',rcode)
398 call ncaptc(cdfid,co_fid,'stagger',NCCHAR,0,'',rcode)
399 call ncaptc(cdfid,co_fid,'coordinates',NCCHAR,10,'XLONG XLAT',rcode)
400 !------Attributes for TMN----------------------------------------
401 call ncapt(cdfid,tmnid,'FieldType',NCLONG, 1,104, rcode)
402 call ncaptc(cdfid,tmnid,'MemoryOrder',NCCHAR, 2,'XY' , rcode)
403 call ncaptc(cdfid,tmnid,'description',NCCHAR,15,'Skin temprature',rcode)
404 call ncaptc(cdfid,tmnid,'units',NCCHAR,1,'K',rcode)
405 call ncaptc(cdfid,tmnid,'stagger',NCCHAR,0,'',rcode)
406 call ncaptc(cdfid,tmnid,'coordinates',NCCHAR,10,'XLONG XLAT',rcode)
407 !------Attributes for XLAT---------------------------------------
408 call ncapt(cdfid,xlatid,'FieldType',NCLONG, 1,104, rcode)
409 call ncaptc(cdfid,xlatid,'MemoryOrder',NCCHAR, 2,'XY' , rcode)
410 call ncaptc(cdfid,xlatid,'description',NCCHAR,27,'LATITUDE, SOUTH IS NEGATIVE',rcode)
411 call ncaptc(cdfid,xlatid,'units',NCCHAR,12,'degree_north',rcode)
412 call ncaptc(cdfid,xlatid,'stagger',NCCHAR,0,'',rcode)
413 !------Attributes for XLONG--------------------------------------
414 call ncapt(cdfid,xlongid,'FieldType',NCLONG, 1,104, rcode)
415 call ncaptc(cdfid,xlongid,'MemoryOrder',NCCHAR, 2,'XY' , rcode)
416 call ncaptc(cdfid,xlongid,'description',NCCHAR,26,'LATITUDE, WEST IS NEGATIVE',rcode)
417 call ncaptc(cdfid,xlongid,'units',NCCHAR,12,'degree_east',rcode)
418 call ncaptc(cdfid,xlongid,'stagger',NCCHAR,0,'',rcode)
419 !------Attributes for XLAT_U-------------------------------------
420 call ncapt(cdfid,xlat_uid,'FieldType',NCLONG, 1,104, rcode)
421 call ncaptc(cdfid,xlat_uid,'MemoryOrder',NCCHAR, 2,'XY' , rcode)
422 call ncaptc(cdfid,xlat_uid,'description',NCCHAR,27,'LATITUDE, SOUTH IS NEGATIVE',rcode)
423 call ncaptc(cdfid,xlat_uid,'units',NCCHAR,12,'degree_north',rcode)
424 call ncaptc(cdfid,xlat_uid,'stagger',NCCHAR,0,'',rcode)
425 call ncaptc(cdfid,xlat_uid,'coordinates',NCCHAR,14,'XLONG_U XLAT_U',rcode)
426 !------Attributes for XLONG_U------------------------------------
427 call ncapt(cdfid,xlong_uid,'FieldType',NCLONG, 1,104, rcode)
428 call ncaptc(cdfid,xlong_uid,'MemoryOrder',NCCHAR, 2,'XY' , rcode)
429 call ncaptc(cdfid,xlong_uid,'description',NCCHAR,26,'LATITUDE, WEST IS NEGATIVE',rcode)
430 call ncaptc(cdfid,xlong_uid,'units',NCCHAR,12,'degree_east',rcode)
431 call ncaptc(cdfid,xlong_uid,'stagger',NCCHAR,0,'',rcode)
432 call ncaptc(cdfid,xlong_uid,'coordinates',NCCHAR,14,'XLONG_U XLAT_U',rcode)
433 !------Attributes for XLAT_V-------------------------------------
434 call ncapt(cdfid,xlat_vid,'FieldType',NCLONG, 1,104, rcode)
435 call ncaptc(cdfid,xlat_vid,'MemoryOrder',NCCHAR, 2,'XY' , rcode)
436 call ncaptc(cdfid,xlat_vid,'description',NCCHAR,27,'LATITUDE, SOUTH IS NEGATIVE',rcode)
437 call ncaptc(cdfid,xlat_vid,'units',NCCHAR,12,'degree_north',rcode)
438 call ncaptc(cdfid,xlat_vid,'stagger',NCCHAR,0,'',rcode)
439 call ncaptc(cdfid,xlat_vid,'coordinates',NCCHAR,14,'XLONG_V XLAT_V',rcode)
440 !------Attributes for XLONG_V------------------------------------
441 call ncapt(cdfid,xlong_vid,'FieldType',NCLONG, 1,104, rcode)
442 call ncaptc(cdfid,xlong_vid,'MemoryOrder',NCCHAR, 2,'XY' , rcode)
443 call ncaptc(cdfid,xlong_vid,'description',NCCHAR,26,'LATITUDE, WEST IS NEGATIVE',rcode)
444 call ncaptc(cdfid,xlong_vid,'units',NCCHAR,12,'degree_east',rcode)
445 call ncaptc(cdfid,xlong_vid,'stagger',NCCHAR,0,'',rcode)
446 call ncaptc(cdfid,xlong_vid,'coordinates',NCCHAR,14,'XLONG_V XLAT_V',rcode)
447 !------Attributes for SNOWC--------------------------------------
448 call ncapt(cdfid,snowcid,'FieldType',NCLONG, 1,104, rcode)
449 call ncaptc(cdfid,snowcid,'MemoryOrder',NCCHAR, 2,'XY' , rcode)
450 call ncaptc(cdfid,snowcid,'description',NCCHAR,48,'FLAG INDICATING SNOW COVERAGE (1 FOR SNOW COVER)',rcode)
451 call ncaptc(cdfid,snowcid,'units',NCCHAR,0,'',rcode)
452 call ncaptc(cdfid,snowcid,'stagger',NCCHAR,0,'',rcode)
453 call ncaptc(cdfid,snowcid,'coordinates',NCCHAR,10,'XLONG XLAT',rcode)
454 !------Attributes for LU_INDEX-----------------------------------
455 call ncapt(cdfid,lu_indexid,'FieldType',NCLONG, 1,104, rcode)
456 call ncaptc(cdfid,lu_indexid,'MemoryOrder',NCCHAR, 2,'XY' , rcode)
457 call ncaptc(cdfid,lu_indexid,'description',NCCHAR,17,'LAND USE CATAGORY',rcode)
458 call ncaptc(cdfid,lu_indexid,'units',NCCHAR,0,'',rcode)
459 call ncaptc(cdfid,lu_indexid,'stagger',NCCHAR,0,'',rcode)
460 call ncaptc(cdfid,lu_indexid,'coordinates',NCCHAR,10,'XLONG XLAT',rcode)
461 !------Attributes for LANDMASK-----------------------------------
462 call ncapt(cdfid,landmaskid,'FieldType',NCLONG, 1,104, rcode)
463 call ncaptc(cdfid,landmaskid,'MemoryOrder',NCCHAR, 2,'XY' , rcode)
464 call ncaptc(cdfid,landmaskid,'description',NCCHAR,35,'LAND MASK (1 FOR LAND, 0 FOR WATER)',rcode)
465 call ncaptc(cdfid,landmaskid,'units',NCCHAR,0,'',rcode)
466 call ncaptc(cdfid,landmaskid,'stagger',NCCHAR,0,'',rcode)
467 call ncaptc(cdfid,landmaskid,'coordinates',NCCHAR,10,'XLONG XLAT',rcode)
468 !------Attributes for XLAND--------------------------------------
469 call ncapt(cdfid,xlandid,'FieldType',NCLONG, 1,104, rcode)
470 call ncaptc(cdfid,xlandid,'MemoryOrder',NCCHAR, 2,'XY' , rcode)
471 call ncaptc(cdfid,xlandid,'description',NCCHAR,35,'LAND MASK (1 FOR LAND, 2 FOR WATER)',rcode)
472 call ncaptc(cdfid,xlandid,'units',NCCHAR,0,'',rcode)
473 call ncaptc(cdfid,xlandid,'stagger',NCCHAR,0,'',rcode)
474 call ncaptc(cdfid,xlandid,'coordinates',NCCHAR,10,'XLONG XLAT',rcode)
475 !------Attributes for SMOIS--------------------------------------
476 call ncapt(cdfid,smoisid,'FieldType',NCLONG, 1,104, rcode)
477 call ncaptc(cdfid,smoisid,'MemoryOrder',NCCHAR, 2,'XY' , rcode)
478 call ncaptc(cdfid,smoisid,'description',NCCHAR,13,'Soil moisture',rcode)
479 call ncaptc(cdfid,smoisid,'units',NCCHAR,0,'',rcode)
480 call ncaptc(cdfid,smoisid,'stagger',NCCHAR,0,'',rcode)
481 call ncaptc(cdfid,smoisid,'coordinates',NCCHAR,10,'XLONG XLAT',rcode)
482 !------Attributes for TSLB---------------------------------------
483 call ncapt(cdfid,tslbid,'FieldType',NCLONG, 1,104, rcode)
484 call ncaptc(cdfid,tslbid,'MemoryOrder',NCCHAR, 2,'XY' , rcode)
485 call ncaptc(cdfid,tslbid,'description',NCCHAR,16,'Soil temperature',rcode)
486 call ncaptc(cdfid,tslbid,'units',NCCHAR,0,'',rcode)
487 call ncaptc(cdfid,tslbid,'stagger',NCCHAR,0,'',rcode)
488 call ncaptc(cdfid,tslbid,'coordinates',NCCHAR,10,'XLONG XLAT',rcode)
489 !------Attributes for SEAICE-------------------------------------
490 call ncapt(cdfid,seaiceid,'FieldType',NCLONG, 1,104, rcode)
491 call ncaptc(cdfid,seaiceid,'MemoryOrder',NCCHAR, 2,'XY' , rcode)
492 call ncaptc(cdfid,seaiceid,'description',NCCHAR,12,'SEA ICE FLAG',rcode)
493 call ncaptc(cdfid,seaiceid,'units',NCCHAR,0,'',rcode)
494 call ncaptc(cdfid,seaiceid,'stagger',NCCHAR,0,'',rcode)
495 call ncaptc(cdfid,seaiceid,'coordinates',NCCHAR,10,'XLONG XLAT',rcode)
496 !------Attributes for IVGTYP-------------------------------------
497 call ncapt(cdfid,ivgtypid,'FieldType',NCLONG, 1,104, rcode)
498 call ncaptc(cdfid,ivgtypid,'MemoryOrder',NCCHAR, 2,'XY' , rcode)
499 call ncaptc(cdfid,ivgtypid,'description',NCCHAR,19,'VEGETATION CATAGORY',rcode)
500 call ncaptc(cdfid,ivgtypid,'units',NCCHAR,0,'',rcode)
501 call ncaptc(cdfid,ivgtypid,'stagger',NCCHAR,0,'',rcode)
502 call ncaptc(cdfid,ivgtypid,'coordinates',NCCHAR,10,'XLONG XLAT',rcode)
503 !------Attributes for ISLTYP-------------------------------------
504 call ncapt(cdfid,isltypid,'FieldType',NCLONG, 1,104, rcode)
505 call ncaptc(cdfid,isltypid,'MemoryOrder',NCCHAR, 2,'XY' , rcode)
506 call ncaptc(cdfid,isltypid,'description',NCCHAR,22,'DOMINANT SOIL CATAGORY',rcode)
507 call ncaptc(cdfid,isltypid,'units',NCCHAR,0,'',rcode)
508 call ncaptc(cdfid,isltypid,'stagger',NCCHAR,0,'',rcode)
509 call ncaptc(cdfid,isltypid,'coordinates',NCCHAR,10,'XLONG XLAT',rcode)
510 !------Attributes for VEGFRA-------------------------------------
511 call ncapt(cdfid,vegfraid,'FieldType',NCLONG, 1,104, rcode)
512 call ncaptc(cdfid,vegfraid,'MemoryOrder',NCCHAR, 2,'XY' , rcode)
513 call ncaptc(cdfid,vegfraid,'description',NCCHAR,19,'VEGETATION FRACTION',rcode)
514 call ncaptc(cdfid,vegfraid,'units',NCCHAR,0,'',rcode)
515 call ncaptc(cdfid,vegfraid,'stagger',NCCHAR,0,'',rcode)
516 call ncaptc(cdfid,vegfraid,'coordinates',NCCHAR,10,'XLONG XLAT',rcode)
517 !------Attributes for SNOWH--------------------------------------
518 call ncapt(cdfid,snowhid,'FieldType',NCLONG, 1,104, rcode)
519 call ncaptc(cdfid,snowhid,'MemoryOrder',NCCHAR, 2,'XY' , rcode)
520 call ncaptc(cdfid,snowhid,'description',NCCHAR,11,'SNOW HEIGHT',rcode)
521 call ncaptc(cdfid,snowhid,'units',NCCHAR,1,'m',rcode)
522 call ncaptc(cdfid,snowhid,'stagger',NCCHAR,0,'',rcode)
523 call ncaptc(cdfid,snowhid,'coordinates',NCCHAR,10,'XLONG XLAT',rcode)
525 !-------Putting new global attributes-----------------------------
527 call ncaptc(cdfid, ncglobal, 'TITLE', NCCHAR, 30, 'OUTPUT FROM CONVERSION PROGRAM', rcode)
528 call ncaptc(cdfid, ncglobal, 'START_DATE', NCCHAR, 19, START_DATE, rcode)
529 call ncaptc(cdfid, ncglobal, 'SIMULATION_START_DATE', NCCHAR, 19, SIM_START_DATE, rcode)
530 call ncapt(cdfid, ncglobal, 'WEST-EAST_GRID_DIMENSION', NCLONG, 1,ew_s, rcode)
531 call ncapt(cdfid, ncglobal, 'SOUTH-NORTH_GRID_DIMENSION', NCLONG, 1,sn_s, rcode)
532 call ncapt(cdfid, ncglobal, 'BOTTOM-TOP_GRID_DIMENSION', NCLONG, 1,bt_s, rcode)
533 call ncapt(cdfid, ncglobal, 'DX', NCFLOAT, 1,dx_meter, rcode)
534 call ncapt(cdfid, ncglobal, 'DY', NCFLOAT, 1,dy_meter, rcode)
535 call ncaptc(cdfid, ncglobal, 'GRIDTYPE', NCCHAR, 1, 'C', rcode)
536 call ncapt(cdfid, ncglobal, 'DIFF_OPT', NCLONG, 1,diff_opt, rcode)
537 call ncapt(cdfid, ncglobal, 'KM_OPT', NCLONG, 1,km_opt, rcode)
538 call ncapt(cdfid, ncglobal, 'DAMP_OPT', NCLONG, 1,damp_opt, rcode)
539 call ncapt(cdfid, ncglobal, 'KHDIF', NCFLOAT, 1,khdif, rcode)
540 call ncapt(cdfid, ncglobal, 'KVDIF', NCFLOAT, 1,kvdif, rcode)
541 call ncapt(cdfid, ncglobal, 'MP_PHYSICS', NCLONG, 1,mp_physics, rcode)
542 call ncapt(cdfid, ncglobal, 'RA_LW_PHYSICS', NCLONG, 1,ra_lw_physics, rcode)
543 call ncapt(cdfid, ncglobal, 'RA_SW_PHYSICS', NCLONG, 1,ra_sw_physics, rcode)
544 call ncapt(cdfid, ncglobal, 'SF_SFCLAY_PHYSICS', NCLONG, 1,sf_sfclay_physics, rcode)
545 call ncapt(cdfid, ncglobal, 'SF_SURFACE_PHYSICS', NCLONG, 1,sf_surface_physics, rcode)
546 call ncapt(cdfid, ncglobal, 'BL_PBL_PHYSICS', NCLONG, 1,bl_pbl_physics, rcode)
547 call ncapt(cdfid, ncglobal, 'CU_PHYSICS', NCLONG, 1,cu_physics, rcode)
548 call ncapt(cdfid, ncglobal, 'SURFACE_INPUT_SOURCE', NCLONG, 1,surface_input_source, rcode)
549 call ncapt(cdfid, ncglobal, 'SST_UPDATE', NCLONG, 1,sst_update, rcode)
550 call ncapt(cdfid, ncglobal, 'WEST-EAST_PATCH_START_UNSTAG', NCLONG, 1,1, rcode)
551 call ncapt(cdfid, ncglobal, 'WEST-EAST_PATCH_END_UNSTAG', NCLONG, 1,ew, rcode)
552 call ncapt(cdfid, ncglobal, 'WEST-EAST_PATCH_START_STAG', NCLONG, 1,1, rcode)
553 call ncapt(cdfid, ncglobal, 'WEST-EAST_PATCH_END_STAG', NCLONG, 1,ew_s, rcode)
554 call ncapt(cdfid, ncglobal, 'SOUTH-NORTH_PATCH_START_UNSTAG', NCLONG, 1,1, rcode)
555 call ncapt(cdfid, ncglobal, 'SOUTH-NORTH_PATCH_END_UNSTAG', NCLONG, 1,sn, rcode)
556 call ncapt(cdfid, ncglobal, 'SOUTH-NORTH_PATCH_START_STAG', NCLONG, 1,1, rcode)
557 call ncapt(cdfid, ncglobal, 'SOUTH-NORTH_PATCH_END_STAG', NCLONG, 1,sn_s, rcode)
558 call ncapt(cdfid, ncglobal, 'BOTTOM_TOP_PATCH_START_UNSTAG', NCLONG, 1,1, rcode)
559 call ncapt(cdfid, ncglobal, 'BOTTOM_TOP_PATCH_END_UNSTAG', NCLONG, 1,bt, rcode)
560 call ncapt(cdfid, ncglobal, 'BOTTOM_TOP_PATCH_START_STAG', NCLONG, 1,1, rcode)
561 call ncapt(cdfid, ncglobal, 'BOTTOM_TOP_PATCH_END_STAG', NCLONG, 1,bt_s, rcode)
562 call ncapt(cdfid, ncglobal, 'DT', NCFLOAT, 1,dt, rcode)
563 call ncapt(cdfid, ncglobal, 'CEN_LAT', NCFLOAT, 1,cen_lat, rcode)
564 call ncapt(cdfid, ncglobal, 'CEN_LON', NCFLOAT, 1,cen_lon, rcode)
565 call ncapt(cdfid, ncglobal, 'TRUELAT1', NCFLOAT, 1,truelat1, rcode)
566 call ncapt(cdfid, ncglobal, 'TRUELAT2', NCFLOAT, 1,truelat2, rcode)
567 call ncapt(cdfid, ncglobal, 'MODE_CEN_LAT', NCFLOAT, 1,mode_cen_lat, rcode)
568 call ncapt(cdfid, ncglobal, 'STAND_LON', NCFLOAT, 1,stand_lon, rcode)
569 call ncapt(cdfid, ncglobal, 'MAP_PROJ', NCLONG, 1,map_proj, rcode)
571 !------Close the new file------------------------------------------
572 call ncendf(cdfid, rcode)
573 call ncvptc(cdfid, timesid, TSTART, TCOUNT,FCST_TIME,30, rcode)
574 call ncclos(cdfid, rcode)
575 !---------------------------------------------------------------------
576 call get_dims_cdf(input_file,'U', dims, ndims, debug)
577 call get_dims_cdf(input_file,'V', dims, ndims, debug)
578 call get_dims_cdf(input_file,'T', dims, ndims, debug)
579 call get_dims_cdf(input_file,'Q', dims, ndims, debug)
581 allocate(u_e(dims(1), dims(2), dims(3)))
582 allocate(v_e(dims(1), dims(2), dims(3)))
583 allocate(t_e(dims(1), dims(2), dims(3)))
584 allocate(q_e(dims(1), dims(2), dims(3)))
585 call get_var_3d_real_cdf(input_file, 'U',u_e, &
586 dims(1), dims(2), dims(3),1, debug )
587 call get_var_3d_real_cdf(input_file, 'V',v_e, &
588 dims(1), dims(2), dims(3),1, debug )
589 call get_var_3d_real_cdf(input_file, 'T',t_e, &
590 dims(1), dims(2), dims(3),1, debug )
591 call get_var_3d_real_cdf(input_file, 'Q',q_e, &
592 dims(1), dims(2), dims(3),1, debug )
593 nx = dims(1)
594 ny = dims(2)
595 nz = dims(3)
596 nnx = 2*nx-1 ; nny = ny ; nnz = nz
597 allocate(u_a(nnx,nny,nnz))
598 allocate(v_a(nnx,nny,nnz))
599 allocate(t_a(nnx,nny,nnz))
600 allocate(q_a(nnx,nny,nnz))
601 call fill_nmm_grid3(u_e,nx,ny,nz,u_a,2)
602 nnux = nnx+1 ; nnuy = nny ; nnnz = nnz
603 allocate(u_c(nnux,nnuy,nnnz))
604 call fill_arw_ugrid(u_a,nnx,nny,nnz,u_c)
605 call fill_nmm_grid3(v_e,nx,ny,nz,v_a,2)
606 nnvx = nnx ; nnvy = nny+1 ; nnnz = nnz
607 allocate(v_c(nnvx,nnvy,nnnz))
608 call fill_arw_vgrid(v_a,nnx,nny,nnz,v_c)
609 call put_var_3d_real_cdf(output_file, 'U', u_c, &
610 nnux, nnuy, nnnz, 1, debug )
611 call put_var_3d_real_cdf(output_file, 'V', v_c, &
612 nnvx, nnvy, nnnz, 1, debug )
613 call fill_nmm_grid3(t_e,nx,ny,nz,t_a,1)
614 call fill_nmm_grid3(q_e,nx,ny,nz,q_a,1)
615 call put_var_3d_real_cdf(output_file, 'T', t_a, &
616 nnx, nny, nnz, 1, debug )
617 call put_var_3d_real_cdf(output_file, 'QVAPOR', q_a, &
618 nnx, nny, nnz, 1, debug )
619 call put_var_3d_real_cdf(output_file, 'QCLOUD', q_a, &
620 nnx, nny, nnz, 1, debug )
621 call put_var_3d_real_cdf(output_file, 'QRAIN', q_a, &
622 nnx, nny, nnz, 1, debug )
623 call put_var_3d_real_cdf(output_file, 'QICE', q_a, &
624 nnx, nny, nnz, 1, debug )
625 deallocate (u_e)
626 deallocate (v_e)
627 deallocate (t_e)
628 deallocate (q_e)
629 deallocate (u_a)
630 deallocate (v_a)
631 deallocate (t_a)
632 deallocate (q_a)
633 deallocate (u_c)
634 deallocate (v_c)
635 !------------------------------------------------------------------
636 !------------Two dimensional variables------------------------
637 !------------------------------------------------------------------
638 call get_dims_cdf(input_file,'U10', dims, ndims, debug)
639 call get_dims_cdf(input_file,'V10', dims, ndims, debug)
640 call get_dims_cdf(input_file,'T2', dims, ndims, debug)
641 call get_dims_cdf(input_file,'QS', dims, ndims, debug)
642 call get_dims_cdf(input_file,'PD', dims, ndims, debug)
643 call get_dims_cdf(input_file,'DX_NMM', dims, ndims, debug)
644 call get_dims_cdf(input_file,'FIS', dims, ndims, debug)
645 call get_dims_cdf(input_file,'TSK', dims, ndims, debug)
646 call get_dims_cdf(input_file,'SST', dims, ndims, debug)
647 call get_dims_cdf(input_file,'F', dims, ndims, debug)
648 call get_dims_cdf(input_file,'SOILTB', dims, ndims, debug)
649 call get_dims_cdf(input_file,'GLAT', dims, ndims, debug)
650 call get_dims_cdf(input_file,'GLON', dims, ndims, debug)
651 call get_dims_cdf(input_file,'ACSNOW', dims, ndims, debug)
652 call get_dims_cdf(input_file,'LU_INDEX', dims, ndims, debug)
653 call get_dims_cdf(input_file,'LANDMASK', dims, ndims, debug)
654 call get_dims_cdf(input_file,'SEAICE', dims, ndims, debug)
655 call get_dims_cdf(input_file,'IVGTYP', dims, ndims, debug)
656 call get_dims_cdf(input_file,'ISLTYP', dims, ndims, debug)
657 call get_dims_cdf(input_file,'VEGFRA', dims, ndims, debug)
658 call get_dims_cdf(input_file,'SNOWH', dims, ndims, debug)
659 allocate(u10_e(dims(1), dims(2)))
660 allocate(v10_e(dims(1), dims(2)))
661 allocate(t2_e(dims(1), dims(2)))
662 allocate(qs_e(dims(1), dims(2)))
663 allocate(pd_e(dims(1), dims(2)))
664 allocate(dx_nmm_e(dims(1), dims(2)))
665 allocate(fis_e(dims(1), dims(2)))
666 allocate(tsk_e(dims(1), dims(2)))
667 allocate(sst_e(dims(1), dims(2)))
668 allocate(co_f_e(dims(1), dims(2)))
669 allocate(soiltb_e(dims(1), dims(2)))
670 allocate(glat_e(dims(1), dims(2)))
671 allocate(glon_e(dims(1), dims(2)))
672 allocate(acsnow_e(dims(1), dims(2)))
673 allocate(lu_index_e(dims(1), dims(2)))
674 allocate(landmask_e(dims(1), dims(2)))
675 allocate(seaice_e(dims(1), dims(2)))
676 allocate(ivgtyp_e(dims(1), dims(2)))
677 allocate(isltyp_e(dims(1), dims(2)))
678 allocate(vegfra_e(dims(1), dims(2)))
679 allocate(snowh_e(dims(1), dims(2)))
680 allocate(clat_e(dims(1), dims(2)))
681 allocate(mapfac_mx_e(dims(1), dims(2)))
682 call get_var_2d_real_cdf(input_file, 'U10',u10_e, &
683 dims(1), dims(2),1, debug )
684 call get_var_2d_real_cdf(input_file, 'V10',v10_e, &
685 dims(1), dims(2),1, debug )
686 call get_var_2d_real_cdf(input_file, 'T2',t2_e, &
687 dims(1), dims(2),1, debug )
688 call get_var_2d_real_cdf(input_file, 'QS',qs_e, &
689 dims(1), dims(2),1, debug )
690 call get_var_2d_real_cdf(input_file, 'PD',pd_e, &
691 dims(1), dims(2),1, debug )
692 call get_var_2d_real_cdf(input_file, 'DX_NMM',dx_nmm_e, &
693 dims(1), dims(2),1, debug )
694 call get_var_2d_real_cdf(input_file, 'FIS',fis_e, &
695 dims(1), dims(2),1, debug )
696 call get_var_2d_real_cdf(input_file, 'TSK',tsk_e, &
697 dims(1), dims(2),1, debug )
698 call get_var_2d_real_cdf(input_file, 'SST',sst_e, &
699 dims(1), dims(2),1, debug )
700 call get_var_2d_real_cdf(input_file, 'F',co_f_e, &
701 dims(1), dims(2),1, debug )
702 call get_var_2d_real_cdf(input_file, 'SOILTB',soiltb_e, &
703 dims(1), dims(2),1, debug )
704 call get_var_2d_real_cdf(input_file, 'GLAT',glat_e, &
705 dims(1), dims(2),1, debug )
706 call get_var_2d_real_cdf(input_file, 'GLON',glon_e, &
707 dims(1), dims(2),1, debug )
708 call get_var_2d_real_cdf(input_file, 'ACSNOW',acsnow_e, &
709 dims(1), dims(2),1, debug )
710 call get_var_2d_real_cdf(input_file, 'LU_INDEX',lu_index_e, &
711 dims(1), dims(2),1, debug )
712 call get_var_2d_real_cdf(input_file, 'LANDMASK',landmask_e, &
713 dims(1), dims(2),1, debug )
714 call get_var_2d_real_cdf(input_file, 'SEAICE',seaice_e, &
715 dims(1), dims(2),1, debug )
716 call get_var_2d_int_cdf(input_file, 'IVGTYP',ivgtyp_e, &
717 dims(1), dims(2),1, debug )
718 call get_var_2d_int_cdf(input_file, 'ISLTYP',isltyp_e, &
719 dims(1), dims(2),1, debug )
720 call get_var_2d_real_cdf(input_file, 'VEGFRA',vegfra_e, &
721 dims(1), dims(2),1, debug )
722 call get_var_2d_real_cdf(input_file, 'SNOWH',snowh_e, &
723 dims(1), dims(2),1, debug )
724 nx = dims(1)
725 ny = dims(2)
726 nnx = 2*nx-1 ; nny = ny
727 nnmx = nx; nnmy = (ny+1)/2
728 nnux = nnx+1; nnuy = nny
729 nnvx = nnx; nnvy = nny+1
730 do j = nnmy, nnmy
731 do i = 1, nnmx
732 clat_e(i,j) = 0.
733 mapfac_mx_e(i,j) = 1.0/(COS(clat_e(i,j)*(3.1415926/180.0)))
734 end do
735 end do
736 do j = nnmy+1, ny
737 do i = 1, nnmx
738 clat_e(i,j) = clat_e(i,j-1) + dellat
739 mapfac_mx_e(i,j) = 1.0/(COS(clat_e(i,j)*(3.1415926/180.0)))
740 end do
741 end do
742 do j = nnmy-1, 1, -1
743 do i = 1, nnmx
744 clat_e(i,j) = clat_e(i,j+1) - dellat
745 mapfac_mx_e(i,j) = 1.0/(COS(clat_e(i,j)*(3.1415926/180.0)))
746 end do
747 end do
748 allocate(u10_a(nnx,nny))
749 allocate(v10_a(nnx,nny))
750 allocate(t2_a(nnx,nny))
751 allocate(qs_a(nnx,nny))
752 allocate(pd_a(nnx,nny))
753 allocate(mu_a(nnx,nny))
754 allocate(dx_nmm_a(nnx,nny))
755 allocate(fis_a(nnx,nny))
756 allocate(tsk_a(nnx,nny))
757 allocate(sst_a(nnx,nny))
758 allocate(co_f_a(nnx,nny))
759 allocate(soiltb_a(nnx,nny))
760 allocate(glat_a(nnx,nny))
761 allocate(glon_a(nnx,nny))
762 allocate(acsnow_a(nnx,nny))
763 allocate(lu_index_a(nnx,nny))
764 allocate(landmask_a(nnx,nny))
765 allocate(seaice_a(nnx,nny))
766 allocate(ivgtyp_a(nnx,nny))
767 allocate(isltyp_a(nnx,nny))
768 allocate(vegfra_a(nnx,nny))
769 allocate(snowh_a(nnx,nny))
770 allocate(mapfac_mx_a(nnx,nny))
772 call fill_nmm_grid2(u10_e,nx,ny,u10_a,2)
773 call fill_nmm_grid2(v10_e,nx,ny,v10_a,2)
774 call fill_nmm_grid2(t2_e,nx,ny,t2_a,1)
775 call fill_nmm_grid2(qs_e,nx,ny,qs_a,1)
776 call fill_nmm_grid2(pd_e,nx,ny,pd_a,1)
777 call fill_nmm_grid2(dx_nmm_e,nx,ny,dx_nmm_a,1)
778 call fill_nmm_grid2(fis_e,nx,ny,fis_a,1)
779 call fill_nmm_grid2(tsk_e,nx,ny,tsk_a,1)
780 call fill_nmm_grid2(sst_e,nx,ny,sst_a,1)
781 call fill_nmm_grid2(co_f_e,nx,ny,co_f_a,1)
782 call fill_nmm_grid2(soiltb_e,nx,ny,soiltb_a,1)
783 call fill_nmm_grid2(glat_e,nx,ny,glat_a,1)
784 call fill_nmm_grid2(glon_e,nx,ny,glon_a,1)
785 call fill_nmm_grid2(acsnow_e,nx,ny,acsnow_a,1)
786 call fill_nmm_grid2(lu_index_e,nx,ny,lu_index_a,1)
787 call fill_nmm_grid2(landmask_e,nx,ny,landmask_a,1)
788 call fill_nmm_grid2(seaice_e,nx,ny,seaice_a,1)
789 call fill_nmm_grid2(ivgtyp_e,nx,ny,ivgtyp_a,1)
790 call fill_nmm_grid2(isltyp_e,nx,ny,ivgtyp_a,1)
791 call fill_nmm_grid2(vegfra_e,nx,ny,vegfra_a,1)
792 call fill_nmm_grid2(snowh_e,nx,ny,snowh_a,1)
793 call fill_nmm_grid2(mapfac_mx_e,nx,ny,mapfac_mx_a,1)
795 allocate(mapfac_ux_c(nnux,nnuy))
796 call fill_arw_xllu_grid(mapfac_mx_a,nnx,nny,mapfac_ux_c)
797 allocate(mapfac_vx_c(nnvx,nnvy))
798 call fill_arw_xllv_grid(mapfac_mx_a,nnx,nny,mapfac_vx_c)
799 do j = 1, nny
800 do i = 1, nnx
801 mu_a(i,j) = PDTOP
802 fis_a(i,j) = fis_a(i,j)/9.8
803 glat_a(i,j) = glat_a(i,j)*R2D
804 glon_a(i,j) = glon_a(i,j)*R2D
805 end do
806 end do
807 allocate(xlat_u_c(nnux,nnuy))
808 allocate(xlong_u_c(nnux,nnuy))
809 call fill_arw_xllu_grid(glat_a,nnx,nny,xlat_u_c)
810 call fill_arw_xllu_grid(glon_a,nnx,nny,xlong_u_c)
811 allocate(xlat_v_c(nnvx,nnvy))
812 allocate(xlong_v_c(nnvx,nnvy))
813 call fill_arw_xllv_grid(glat_a,nnx,nny,xlat_v_c)
814 call fill_arw_xllv_grid(glon_a,nnx,nny,xlong_v_c)
816 call put_var_2d_real_cdf(output_file, 'U10', u10_a, &
817 nnx, nny, 1, debug )
818 call put_var_2d_real_cdf(output_file, 'V10', v10_a, &
819 nnx, nny, 1, debug )
820 call put_var_2d_real_cdf(output_file, 'T2', t2_a, &
821 nnx, nny, 1, debug )
822 call put_var_2d_real_cdf(output_file, 'Q2', qs_a, &
823 nnx, nny, 1, debug )
824 call put_var_2d_real_cdf(output_file, 'PSFC', pd_a, &
825 nnx, nny, 1, debug )
826 call put_var_2d_real_cdf(output_file, 'MU', mu_a, &
827 nnx, nny, 1, debug )
828 call put_var_2d_real_cdf(output_file, 'MU0', dx_nmm_a, &
829 nnx, nny, 1, debug )
830 call put_var_2d_real_cdf(output_file, 'HGT', fis_a, &
831 nnx, nny, 1, debug )
832 call put_var_2d_real_cdf(output_file, 'TSK', tsk_a, &
833 nnx, nny, 1, debug )
834 call put_var_2d_real_cdf(output_file, 'SST', sst_a, &
835 nnx, nny, 1, debug )
836 call put_var_2d_real_cdf(output_file, 'F', co_f_a, &
837 nnx, nny, 1, debug )
838 call put_var_2d_real_cdf(output_file, 'TMN', soiltb_a, &
839 nnx, nny, 1, debug )
840 call put_var_2d_real_cdf(output_file, 'XLAT', glat_a, &
841 nnx, nny, 1, debug )
842 call put_var_2d_real_cdf(output_file, 'XLONG', glon_a, &
843 nnx, nny, 1, debug )
844 call put_var_2d_real_cdf(output_file, 'SNOWC', acsnow_a, &
845 nnx, nny, 1, debug )
846 call put_var_2d_real_cdf(output_file, 'LU_INDEX', lu_index_a, &
847 nnx, nny, 1, debug )
848 call put_var_2d_real_cdf(output_file, 'LANDMASK', landmask_a, &
849 nnx, nny, 1, debug )
850 call put_var_2d_real_cdf(output_file, 'SEAICE', seaice_a, &
851 nnx, nny, 1, debug )
852 call put_var_2d_int_cdf(output_file, 'IVGTYP', ivgtyp_a, &
853 nnx, nny, 1, debug )
854 call put_var_2d_int_cdf(output_file, 'ISLTYP', ivgtyp_a, &
855 nnx, nny, 1, debug )
856 call put_var_2d_real_cdf(output_file, 'VEGFRA', vegfra_a, &
857 nnx, nny, 1, debug )
858 call put_var_2d_real_cdf(output_file, 'SNOWH', snowh_a, &
859 nnx, nny, 1, debug )
860 call put_var_2d_real_cdf(output_file, 'MAPFAC_MX', mapfac_mx_a, &
861 nnx, nny, 1, debug )
862 call put_var_2d_real_cdf(output_file, 'MAPFAC_UX', mapfac_ux_c, &
863 nnux, nnuy, 1, debug )
864 call put_var_2d_real_cdf(output_file, 'MAPFAC_VX', mapfac_vx_c, &
865 nnvx, nnvy, 1, debug )
866 call put_var_2d_real_cdf(output_file, 'XLAT_U', xlat_u_c, &
867 nnux, nnuy, 1, debug )
868 call put_var_2d_real_cdf(output_file, 'XLONG_U', xlong_u_c, &
869 nnux, nnuy, 1, debug )
870 call put_var_2d_real_cdf(output_file, 'XLAT_V', xlat_v_c, &
871 nnvx, nnvy, 1, debug )
872 call put_var_2d_real_cdf(output_file, 'XLONG_V', xlong_v_c, &
873 nnvx, nnvy, 1, debug )
874 !------------------------------------------------------------------------
875 !----------Variables for which the levels are the SOIL levels-----
876 !------------------------------------------------------------------------
877 call get_dims_cdf(input_file,'SMC', dims, ndims, debug)
878 call get_dims_cdf(input_file,'STC', dims, ndims, debug)
879 allocate(smc_e(dims(1), dims(2), dims(3)))
880 allocate(stc_e(dims(1), dims(2), dims(3)))
881 call get_var_3d_real_cdf(input_file, 'SMC',smc_e, &
882 dims(1), dims(2), dims(3), 1, debug )
883 call get_var_3d_real_cdf(input_file, 'STC',stc_e, &
884 dims(1), dims(2), dims(3), 1, debug )
885 nx = dims(1)
886 ny = dims(2)
887 nz = dims(3)
888 nnx = 2*nx-1 ; nny = ny ; nnz = nz
889 allocate(smc_a(nnx,nny,nnz))
890 allocate(stc_a(nnx,nny,nnz))
891 call fill_nmm_grid3(smc_e,nx,ny,nz,smc_a,1)
892 call fill_nmm_grid3(stc_e,nx,ny,nz,stc_a,1)
893 call put_var_3d_real_cdf(output_file, 'SMOIS', smc_a, &
894 nnx, nny, nnz, 1, debug )
895 call put_var_3d_real_cdf(output_file, 'TSLB', stc_a, &
896 nnx, nny, nnz, 1, debug )
898 !----------------------1D Variables-----------------------------
899 call get_dims_cdf(input_file,'ETA1', dims, ndims, debug)
900 allocate(eta1(dims(1)))
901 call get_var_1d_real_cdf(input_file, 'ETA1',eta1, &
902 dims(1),1, debug )
903 nx = dims(1)
904 nnx= nx
905 call put_var_1d_real_cdf(output_file, 'ZNW', eta1, &
906 nnx, 1, debug )
907 call get_dims_cdf(input_file,'ETA2', dims, ndims, debug)
908 allocate(eta2(dims(1)))
909 call get_var_1d_real_cdf(input_file, 'ETA2',eta2, &
910 dims(1),1, debug )
911 nx = dims(1)-1
912 nnx= nx
913 call put_var_1d_real_cdf(output_file, 'ZNU', eta2, &
914 nnx, 1, debug )
915 !----------------Single Value------------------------------------
916 call get_dims_cdf(input_file,'PT', dims, ndims, debug)
917 call get_var_0d_real_cdf(input_file, 'PT',ptop, &
918 1, debug )
919 call put_var_0d_real_cdf(output_file,'P_TOP',ptop, &
920 1, debug )
921 call put_var_0d_real_cdf(output_file,'CF1',dx, &
922 1, debug )
923 call put_var_0d_real_cdf(output_file,'CF2',dy, &
924 1, debug )
926 stop
927 end program convert_etoc
928 !------------------------------------------------------------
929 subroutine get_dims_cdf( file, var, dims, ndims, debug )
931 implicit none
933 include 'netcdf.inc'
935 character (len=80), intent(in) :: file
936 character (len=*), intent(in) :: var
937 logical, intent(in ) :: debug
938 integer, intent(out), dimension(4) :: dims
939 integer, intent(out) :: ndims
941 integer cdfid, rcode, id_time
942 character (len=80) :: varnam, time1
943 integer :: natts, istart(10),iend(10), dimids(10)
944 integer :: i, ivtype
946 cdfid = ncopn(file, NCNOWRIT, rcode )
948 if( rcode == 0) then
949 if(debug) write(6,*) ' open netcdf file ', trim(file)
950 else
951 write(6,*) ' error openiing netcdf file ', trim(file)
952 stop
953 end if
955 id_time = ncvid( cdfid, var, rcode )
957 rcode = nf_inq_var( cdfid, id_time, varnam, ivtype, ndims, dimids, natts )
958 if(debug) then
959 write(6,*) ' number of dims for ',var,' ',ndims
960 endif
961 do i=1,ndims
962 rcode = nf_inq_dimlen( cdfid, dimids(i), dims(i) )
963 if(debug) write(6,*) ' dimension ',i,dims(i)
964 enddo
966 call ncclos(cdfid,rcode)
968 end subroutine get_dims_cdf
969 !------------------------------------------------------------
970 subroutine get_var_0d_real_cdf( file, var, data, &
971 time, debug )
973 implicit none
975 include 'netcdf.inc'
977 integer, intent(in) :: time
978 character (len=80), intent(in) :: file
979 logical, intent(in ) :: debug
980 character (len=*), intent(in) :: var
981 real, intent(out) :: data
982 real(kind=8) :: tmp
984 integer cdfid, rcode, id_data
985 character (len=80) :: varnam, time1
986 integer :: ndims, natts, idims(10), istart(10),iend(10), dimids(10)
987 integer :: i, ivtype
989 cdfid = ncopn(file, NCNOWRIT, rcode )
991 if( rcode /= 0) then
992 write(unit=*, fmt='(2a)') ' error openiing netcdf file ', trim(file)
993 stop
994 end if
996 id_data = ncvid( cdfid, var, rcode )
998 rcode = nf_inq_var( cdfid, id_data, varnam, ivtype, ndims, dimids, natts )
1000 if(debug) then
1001 write(unit=*, fmt='(3a,i6)') ' get_var_2d_real_cdf: dims for ',var,' ',ndims
1002 endif
1004 do i=1,ndims
1005 rcode = nf_inq_dimlen( cdfid, dimids(i), idims(i) )
1006 if(debug) then
1007 write(unit=*, fmt='(a,2i6)') ' dimension ',i,idims(i)
1008 write(unit=*, fmt='(a,i6)') ' ivtype=', ivtype
1009 write(unit=*, fmt='(a, a)') ' varnam=', trim(varnam)
1010 endif
1011 enddo
1013 ! check the dimensions
1015 if( (time > idims(1)) ) then
1017 write(6,*) ' error in single value read, dimension problem '
1018 write(6,*) time, idims(1)
1019 write(6,*) ' error stop '
1020 stop
1022 end if
1024 ! get the data
1026 istart(1) = time
1027 iend(1) = 1
1029 if((ivtype == NF_REAL) .and. (kind(data) == 4)) then
1030 call ncvgt( cdfid,id_data,istart,iend,data,rcode)
1031 else if((ivtype == NF_DOUBLE) .and. (kind(data) == 8)) then
1032 call ncvgt( cdfid,id_data,istart,iend,data,rcode)
1033 else if((ivtype == NF_DOUBLE) .and. (kind(data) == 4)) then
1034 call ncvgt( cdfid,id_data,istart,iend,tmp,rcode)
1035 data = tmp
1036 else
1037 write(unit=*, fmt='(a, i6)') &
1038 'Unrecognizable ivtype:', ivtype
1039 stop
1040 endif
1042 if(debug) then
1043 write(unit=*, fmt='(a,e24.12)') ' Sample data=', data
1044 endif
1046 call ncclos(cdfid,rcode)
1048 end subroutine get_var_0d_real_cdf
1050 !--------------------------------------------------------------------
1051 subroutine put_var_0d_real_cdf( file, var, data, &
1052 time, debug )
1054 implicit none
1056 include 'netcdf.inc'
1058 integer, intent(in) :: time
1059 character (len=80), intent(in) :: file
1060 logical, intent(in ) :: debug
1061 character (len=*), intent(in) :: var
1062 real, intent(in) :: data
1063 real(kind=8) :: tmp
1065 integer :: cdfid, rcode, id_data
1066 character (len=80) :: varnam, time1
1067 integer :: ndims, natts, idims(10), istart(10),iend(10), dimids(10)
1068 integer :: i, ivtype
1070 cdfid = ncopn(file, NCWRITE, rcode )
1072 if( rcode == 0) then
1073 if(debug) write(6,*) ' open netcdf file ', trim(file)
1074 else
1075 write(6,*) ' error openiing netcdf file ', trim(file)
1076 stop
1077 end if
1079 id_data = ncvid( cdfid, var, rcode )
1081 rcode = nf_inq_var( cdfid, id_data, varnam, ivtype, ndims, dimids, natts )
1082 if(debug) then
1083 write(6,*) ' number of dims for ',var,' ',ndims
1084 endif
1085 do i=1,ndims
1086 rcode = nf_inq_dimlen( cdfid, dimids(i), idims(i) )
1087 if(debug) write(6,*) ' dimension ',i,idims(i)
1088 enddo
1090 !---check the dimensions
1092 if( (time > idims(1)) ) then
1094 write(6,*) ' error in single value read, dimension problem '
1095 write(6,*) time, idims(1)
1096 write(6,*) ' error stop '
1097 stop
1098 end if
1100 !----get the data
1102 istart(1) = time
1103 iend(1) = 1
1105 if((ivtype == NF_REAL) .and. (kind(data) == 4)) then
1106 call ncvpt( cdfid,id_data,istart,iend,data,rcode)
1107 else if((ivtype == NF_DOUBLE) .and. (kind(data) == 8)) then
1108 tmp = data
1109 call ncvpt( cdfid,id_data,istart,iend,tmp,rcode)
1110 else if((ivtype == NF_DOUBLE) .and. (kind(data) == 4)) then
1111 tmp = data
1112 call ncvpt( cdfid,id_data,istart,iend,tmp,rcode)
1113 else
1114 write(unit=*, fmt='(a, i6)') &
1115 'Unrecognizable ivtype:', ivtype
1116 stop
1117 endif
1119 call ncclos(cdfid,rcode)
1121 end subroutine put_var_0d_real_cdf
1122 !------------------------------------------------------------
1123 subroutine get_var_1d_real_cdf( file, var, data, &
1124 i1, time, debug )
1126 implicit none
1128 include 'netcdf.inc'
1130 integer, intent(in) :: i1, time
1131 character (len=80), intent(in) :: file
1132 logical, intent(in ) :: debug
1133 character (len=*), intent(in) :: var
1134 real, dimension(i1), intent(out) :: data
1135 real(kind=8), dimension(i1) :: tmp
1137 integer cdfid, rcode, id_data
1138 character (len=80) :: varnam, time1
1139 integer :: ndims, natts, idims(10), istart(10),iend(10), dimids(10)
1140 integer :: i, ivtype
1142 cdfid = ncopn(file, NCNOWRIT, rcode )
1144 if( rcode /= 0) then
1145 write(unit=*, fmt='(2a)') ' error openiing netcdf file ', trim(file)
1146 stop
1147 end if
1149 id_data = ncvid( cdfid, var, rcode )
1151 rcode = nf_inq_var( cdfid, id_data, varnam, ivtype, ndims, dimids, natts )
1153 if(debug) then
1154 write(unit=*, fmt='(3a,i6)') ' get_var_1d_real_cdf: dims for ',var,' ',ndims
1155 endif
1157 do i=1,ndims
1158 rcode = nf_inq_dimlen( cdfid, dimids(i), idims(i) )
1159 if(debug) then
1160 write(unit=*, fmt='(a,2i6)') ' dimension ',i,idims(i)
1161 write(unit=*, fmt='(a,i6)') ' ivtype=', ivtype
1162 write(unit=*, fmt='(a, a)') ' varnam=', trim(varnam)
1163 endif
1164 enddo
1166 ! check the dimensions
1168 if( (i1 /= idims(1)) .or. &
1169 (time > idims(2)) ) then
1171 write(6,*) ' error in 1d_var_real read, dimension problem '
1172 write(6,*) i1, idims(1)
1173 write(6,*) time, idims(2)
1174 write(6,*) ' error stop '
1175 stop
1177 end if
1179 ! get the data
1181 istart(1) = 1
1182 iend(1) = i1
1183 istart(2) = time
1184 iend(2) = 1
1186 if((ivtype == NF_REAL) .and. (kind(data) == 4)) then
1187 call ncvgt( cdfid,id_data,istart,iend,data,rcode)
1188 else if((ivtype == NF_DOUBLE) .and. (kind(data) == 8)) then
1189 call ncvgt( cdfid,id_data,istart,iend,data,rcode)
1190 else if((ivtype == NF_DOUBLE) .and. (kind(data) == 4)) then
1191 call ncvgt( cdfid,id_data,istart,iend,tmp,rcode)
1192 data = tmp
1193 else
1194 write(unit=*, fmt='(a, i6)') &
1195 'Unrecognizable ivtype:', ivtype
1196 stop
1197 endif
1199 if(debug) then
1200 write(unit=*, fmt='(a,e24.12)') ' Sample data=', data(1)
1201 endif
1203 call ncclos(cdfid,rcode)
1205 end subroutine get_var_1d_real_cdf
1207 !--------------------------------------------------------------------
1208 subroutine put_var_1d_real_cdf( file, var, data, &
1209 i1, time, debug )
1211 implicit none
1213 include 'netcdf.inc'
1215 integer, intent(in) :: i1, time
1216 character (len=80), intent(in) :: file
1217 logical, intent(in ) :: debug
1218 character (len=*), intent(in) :: var
1219 real, dimension(i1), intent(in) :: data
1220 real(kind=8), dimension(i1) :: tmp
1222 integer :: cdfid, rcode, id_data
1223 character (len=80) :: varnam, time1
1224 integer :: ndims, natts, idims(10), istart(10),iend(10), dimids(10)
1225 integer :: i, ivtype
1227 cdfid = ncopn(file, NCWRITE, rcode )
1229 if( rcode == 0) then
1230 if(debug) write(6,*) ' open netcdf file ', trim(file)
1231 else
1232 write(6,*) ' error openiing netcdf file ', trim(file)
1233 stop
1234 end if
1236 id_data = ncvid( cdfid, var, rcode )
1238 rcode = nf_inq_var( cdfid, id_data, varnam, ivtype, ndims, dimids, natts )
1239 if(debug) then
1240 write(6,*) ' number of dims for ',var,' ',ndims
1241 endif
1242 do i=1,ndims
1243 rcode = nf_inq_dimlen( cdfid, dimids(i), idims(i) )
1244 if(debug) write(6,*) ' dimension ',i,idims(i)
1245 enddo
1247 !---check the dimensions
1249 if((i1 /= idims(1)) .or. &
1250 (time > idims(2)) ) then
1252 write(6,*) ' error in 1d_var_real read, dimension problem '
1253 write(6,*) i1, idims(1)
1254 write(6,*) time, idims(2)
1255 write(6,*) ' error stop '
1256 stop
1257 end if
1258 !----get the data
1260 istart(1) = 1
1261 iend(1) = i1
1262 istart(2) = time
1263 iend(2) = 1
1265 if((ivtype == NF_REAL) .and. (kind(data) == 4)) then
1266 call ncvpt( cdfid,id_data,istart,iend,data,rcode)
1267 else if((ivtype == NF_DOUBLE) .and. (kind(data) == 8)) then
1268 tmp = data
1269 call ncvpt( cdfid,id_data,istart,iend,tmp,rcode)
1270 else if((ivtype == NF_DOUBLE) .and. (kind(data) == 4)) then
1271 tmp = data
1272 call ncvpt( cdfid,id_data,istart,iend,tmp,rcode)
1273 else
1274 write(unit=*, fmt='(a, i6)') &
1275 'Unrecognizable ivtype:', ivtype
1276 stop
1277 endif
1279 call ncclos(cdfid,rcode)
1281 end subroutine put_var_1d_real_cdf
1283 !------------------------------------------------------------
1284 subroutine get_var_2d_real_cdf( file, var, data, &
1285 i1, i2, time, debug )
1287 implicit none
1289 include 'netcdf.inc'
1291 integer, intent(in) :: i1, i2, time
1292 character (len=80), intent(in) :: file
1293 logical, intent(in ) :: debug
1294 character (len=*), intent(in) :: var
1295 real, dimension(i1,i2), intent(out) :: data
1296 real(kind=8), dimension(i1,i2) :: tmp
1298 integer cdfid, rcode, id_data
1299 character (len=80) :: varnam, time1
1300 integer :: ndims, natts, idims(10), istart(10),iend(10), dimids(10)
1301 integer :: i, ivtype
1303 cdfid = ncopn(file, NCNOWRIT, rcode )
1305 if( rcode /= 0) then
1306 write(unit=*, fmt='(2a)') ' error openiing netcdf file ', trim(file)
1307 stop
1308 end if
1310 id_data = ncvid( cdfid, var, rcode )
1312 rcode = nf_inq_var( cdfid, id_data, varnam, ivtype, ndims, dimids, natts )
1314 if(debug) then
1315 write(unit=*, fmt='(3a,i6)') ' get_var_2d_real_cdf: dims for ',var,' ',ndims
1316 endif
1318 do i=1,ndims
1319 rcode = nf_inq_dimlen( cdfid, dimids(i), idims(i) )
1320 if(debug) then
1321 write(unit=*, fmt='(a,2i6)') ' dimension ',i,idims(i)
1322 write(unit=*, fmt='(a,i6)') ' ivtype=', ivtype
1323 write(unit=*, fmt='(a, a)') ' varnam=', trim(varnam)
1324 endif
1325 enddo
1327 ! check the dimensions
1329 if( (i1 /= idims(1)) .or. &
1330 (i2 /= idims(2)) .or. &
1331 (time > idims(3)) ) then
1333 write(6,*) ' error in 2d_var_real read, dimension problem '
1334 write(6,*) i1, idims(1)
1335 write(6,*) i2, idims(2)
1336 write(6,*) time, idims(3)
1337 write(6,*) ' error stop '
1338 stop
1340 end if
1342 ! get the data
1344 istart(1) = 1
1345 iend(1) = i1
1346 istart(2) = 1
1347 iend(2) = i2
1348 istart(3) = time
1349 iend(3) = 1
1351 if((ivtype == NF_REAL) .and. (kind(data) == 4)) then
1352 call ncvgt( cdfid,id_data,istart,iend,data,rcode)
1353 else if((ivtype == NF_DOUBLE) .and. (kind(data) == 8)) then
1354 call ncvgt( cdfid,id_data,istart,iend,data,rcode)
1355 else if((ivtype == NF_DOUBLE) .and. (kind(data) == 4)) then
1356 call ncvgt( cdfid,id_data,istart,iend,tmp,rcode)
1357 data = tmp
1358 else
1359 write(unit=*, fmt='(a, i6)') &
1360 'Unrecognizable ivtype:', ivtype
1361 stop
1362 endif
1364 if(debug) then
1365 write(unit=*, fmt='(a,e24.12)') ' Sample data=', data(1,1)
1366 endif
1368 call ncclos(cdfid,rcode)
1370 end subroutine get_var_2d_real_cdf
1372 !--------------------------------------------------------------------
1373 subroutine put_var_2d_real_cdf( file, var, data, &
1374 i1, i2, time, debug )
1376 implicit none
1378 include 'netcdf.inc'
1380 integer, intent(in) :: i1, i2, time
1381 character (len=80), intent(in) :: file
1382 logical, intent(in ) :: debug
1383 character (len=*), intent(in) :: var
1384 real, dimension(i1,i2), intent(in) :: data
1385 real(kind=8), dimension(i1,i2) :: tmp
1387 integer :: cdfid, rcode, id_data
1388 character (len=80) :: varnam, time1
1389 integer :: ndims, natts, idims(10), istart(10),iend(10), dimids(10)
1390 integer :: i, ivtype
1392 cdfid = ncopn(file, NCWRITE, rcode )
1394 if( rcode == 0) then
1395 if(debug) write(6,*) ' open netcdf file ', trim(file)
1396 else
1397 write(6,*) ' error openiing netcdf file ', trim(file)
1398 stop
1399 end if
1401 id_data = ncvid( cdfid, var, rcode )
1403 rcode = nf_inq_var( cdfid, id_data, varnam, ivtype, ndims, dimids, natts )
1404 if(debug) then
1405 write(6,*) ' number of dims for ',var,' ',ndims
1406 endif
1407 do i=1,ndims
1408 rcode = nf_inq_dimlen( cdfid, dimids(i), idims(i) )
1409 if(debug) write(6,*) ' dimension ',i,idims(i)
1410 enddo
1412 !---check the dimensions
1414 if((i1 /= idims(1)) .or. &
1415 (i2 /= idims(2)) .or. &
1416 (time > idims(3)) ) then
1418 write(6,*) ' error in 2d_var_real read, dimension problem '
1419 write(6,*) i1, idims(1)
1420 write(6,*) i2, idims(2)
1421 write(6,*) time, idims(3)
1422 write(6,*) ' error stop '
1423 stop
1424 end if
1426 !----get the data
1428 istart(1) = 1
1429 iend(1) = i1
1430 istart(2) = 1
1431 iend(2) = i2
1432 istart(3) = time
1433 iend(3) = 1
1435 if((ivtype == NF_REAL) .and. (kind(data) == 4)) then
1436 call ncvpt( cdfid,id_data,istart,iend,data,rcode)
1437 else if((ivtype == NF_DOUBLE) .and. (kind(data) == 8)) then
1438 tmp = data
1439 call ncvpt( cdfid,id_data,istart,iend,tmp,rcode)
1440 else if((ivtype == NF_DOUBLE) .and. (kind(data) == 4)) then
1441 tmp = data
1442 call ncvpt( cdfid,id_data,istart,iend,tmp,rcode)
1443 else
1444 write(unit=*, fmt='(a, i6)') &
1445 'Unrecognizable ivtype:', ivtype
1446 stop
1447 endif
1449 call ncclos(cdfid,rcode)
1451 end subroutine put_var_2d_real_cdf
1453 !--------------------------------------------------------------------
1455 subroutine get_var_3d_real_cdf( file, var, data, &
1456 i1, i2, i3, time, debug )
1458 implicit none
1460 include 'netcdf.inc'
1462 integer, intent(in) :: i1, i2, i3, time
1463 character (len=80), intent(in) :: file
1464 logical, intent(in ) :: debug
1465 character (len=*), intent(in) :: var
1466 real, dimension(i1,i2,i3), intent(out) :: data
1467 real(kind=8), dimension(i1,i2,i3) :: tmp
1469 character (len=80) :: varnam, time1
1471 integer :: cdfid, rcode, id_data
1472 integer :: ndims, natts, idims(10), istart(10),iend(10), dimids(10)
1473 integer :: i, ivtype
1475 cdfid = ncopn(file, NCNOWRIT, rcode )
1477 if( rcode /= 0) then
1478 write(6,*) ' error openiing netcdf file ', trim(file)
1479 stop
1480 end if
1482 id_data = ncvid( cdfid, var, rcode )
1483 rcode = nf_inq_var( cdfid, id_data, varnam, ivtype, ndims, dimids, natts )
1485 if(debug) then
1486 write(unit=*, fmt='(3a,i6)') ' get_var_3d_real_cdf: dims for ',var,' ',ndims
1487 write(unit=*, fmt='(a,i6)') ' ivtype=', ivtype
1488 write(unit=*, fmt='(a, a)') ' varnam=', trim(varnam)
1489 write(unit=*, fmt='(a,i6)') ' kind(data)=', kind(data)
1490 endif
1492 print*,'get var',var,' ',ndims
1493 do i=1,ndims
1494 rcode = nf_inq_dimlen( cdfid, dimids(i), idims(i) )
1495 if(debug) write(unit=*, fmt='(a,2i6)') ' dimension ',i,idims(i)
1496 enddo
1497 print*, ' rcode ', rcode
1498 print*, ' i1, i2, i3 ', i1, i2, i3
1500 ! check the dimensions
1502 if( (i1 /= idims(1)) .or. &
1503 (i2 /= idims(2)) .or. &
1504 (i3 /= idims(3)) .or. &
1505 (time > idims(4)) ) then
1507 write(6,*) ' error in 3d_var_real read, dimension problem '
1508 write(6,*) i1, idims(1)
1509 write(6,*) i2, idims(2)
1510 write(6,*) i3, idims(3)
1511 write(6,*) time, idims(4)
1512 write(6,*) ' error stop '
1513 stop
1515 end if
1516 ! get the data
1518 istart(1) = 1
1519 iend(1) = i1
1520 istart(2) = 1
1521 iend(2) = i2
1522 istart(3) = 1
1523 iend(3) = i3
1524 istart(4) = time
1525 iend(4) = 1
1527 if((ivtype == NF_REAL) .and. (kind(data) == 4)) then
1528 call ncvgt( cdfid,id_data,istart,iend,data,rcode)
1529 else if((ivtype == NF_DOUBLE) .and. (kind(data) == 4)) then
1530 call ncvgt( cdfid,id_data,istart,iend,tmp,rcode)
1531 data = tmp
1532 else if((ivtype == NF_DOUBLE) .and. (kind(data) == 8)) then
1533 call ncvgt( cdfid,id_data,istart,iend,data,rcode)
1534 else
1535 write(unit=*, fmt='(a, i6)') &
1536 'Unrecognizable ivtype:', ivtype
1537 stop
1538 endif
1540 if(debug) then
1541 write(unit=*, fmt='(a,e24.12)') ' Sample data=', data(1,1,1)
1542 endif
1544 call ncclos(cdfid,rcode)
1546 end subroutine get_var_3d_real_cdf
1548 !--------------------------------------------------------------------
1549 subroutine put_var_3d_real_cdf( file, var, data, &
1550 i1, i2, i3, time, debug )
1552 implicit none
1554 include 'netcdf.inc'
1556 integer, intent(in) :: i1, i2, i3, time
1557 character (len=80), intent(in) :: file
1559 logical, intent(in ) :: debug
1560 character (len=*), intent(in) :: var
1561 real, dimension(i1,i2,i3), intent(in) :: data
1562 real(kind=8), dimension(i1,i2,i3) :: tmp
1564 integer cdfid, rcode, id_data
1565 character (len=80) :: varnam, time1
1566 integer :: ndims, natts, idims(10), istart(10),iend(10), dimids(10)
1567 integer :: i, ivtype
1569 cdfid = ncopn(file, NCWRITE, rcode )
1570 print*,__FILE__,__LINE__
1571 if( rcode /= 0) then
1572 write(unit=*, fmt='(2a)') ' error openiing netcdf file ', trim(file)
1573 stop
1574 end if
1576 id_data = ncvid( cdfid, var, rcode )
1577 print*,__FILE__,__LINE__,'id_date= ',id_data
1579 rcode = nf_inq_var( cdfid, id_data, varnam, ivtype, ndims, dimids, natts )
1581 if(debug) then
1582 write(unit=*, fmt='(3a,i6)') ' put_var_3d_real_cdf: dims for ',var,' ',ndims
1583 endif
1585 do i=1,ndims
1586 rcode = nf_inq_dimlen( cdfid, dimids(i), idims(i) )
1587 if(debug) write(6,*) ' dimension ',i,idims(i)
1588 enddo
1590 ! check the dimensions
1591 if( (i1 /= idims(1)) .or. &
1592 (i2 /= idims(2)) .or. &
1593 ! (i3 /= idims(3)) .or. &
1594 (time > idims(4)) ) then
1596 write(6,*) ' error in 3d_var_real read, dimension problem '
1597 write(6,*) i1, idims(1)
1598 write(6,*) i2, idims(2)
1599 write(6,*) i3, idims(3)
1600 write(6,*) time, idims(4)
1601 write(6,*) ' error stop '
1602 stop
1604 end if
1606 ! get the data
1608 istart(1) = 1
1609 iend(1) = i1
1610 istart(2) = 1
1611 iend(2) = i2
1612 istart(3) = 1
1613 iend(3) = i3
1614 istart(4) = time
1615 iend(4) = 1
1617 if((ivtype == NF_REAL) .and. (kind(data) == 4)) then
1618 call ncvpt( cdfid,id_data,istart,iend,data,rcode)
1619 else if((ivtype == NF_DOUBLE) .and. (kind(data) == 8)) then
1620 tmp = data
1621 call ncvpt( cdfid,id_data,istart,iend,tmp,rcode)
1622 else if((ivtype == NF_DOUBLE) .and. (kind(data) == 4)) then
1623 tmp = data
1624 call ncvpt( cdfid,id_data,istart,iend,tmp,rcode)
1625 else
1626 write(unit=*, fmt='(a, i6)') &
1627 'Unrecognizable ivtype:', ivtype
1628 stop
1629 endif
1631 call ncclos(cdfid,rcode)
1633 end subroutine put_var_3d_real_cdf
1635 !--------------------------------------------------------------------
1636 subroutine get_var_2d_int_cdf(file, var, data, i1, i2, time, debug)
1638 implicit none
1640 include 'netcdf.inc'
1642 integer, intent(in) :: i1, i2, time
1643 character (len=80), intent(in) :: file
1644 logical, intent(in ) :: debug
1645 character (len=*), intent(in) :: var
1646 integer, dimension(i1,i2), intent(out) :: data
1648 integer cdfid, rcode, id_data
1649 character (len=80) :: varnam, time1
1650 integer :: ndims, natts, idims(10), istart(10),iend(10), dimids(10)
1651 integer :: i, ivtype
1653 cdfid = ncopn(file, NCNOWRIT, rcode )
1655 if( rcode /= 0) then
1656 write(unit=*, fmt='(2a)') ' error openiing netcdf file ', trim(file)
1657 stop
1658 end if
1660 id_data = ncvid( cdfid, var, rcode )
1662 rcode = nf_inq_var( cdfid, id_data, varnam, ivtype, ndims, dimids, natts )
1664 if(debug) then
1665 write(unit=*, fmt='(3a,i6)') ' get_var_2d_real_cdf: dims for ',var,' ',ndims
1666 endif
1668 do i=1,ndims
1669 rcode = nf_inq_dimlen( cdfid, dimids(i), idims(i) )
1670 if(debug) then
1671 write(unit=*, fmt='(a,2i6)') ' dimension ',i,idims(i)
1672 write(unit=*, fmt='(a,i6)') ' ivtype=', ivtype
1673 write(unit=*, fmt='(a, a)') ' varnam=', trim(varnam)
1674 endif
1675 enddo
1677 ! check the dimensions
1679 if( (i1 /= idims(1)) .or. &
1680 (i2 /= idims(2)) .or. &
1681 (time > idims(3)) ) then
1683 write(6,*) ' error in 2d_var_real read, dimension problem '
1684 write(6,*) i1, idims(1)
1685 write(6,*) i2, idims(2)
1686 write(6,*) time, idims(4)
1687 write(6,*) ' error stop '
1688 stop
1690 end if
1692 ! get the data
1694 istart(1) = 1
1695 iend(1) = i1
1696 istart(2) = 1
1697 iend(2) = i2
1698 istart(3) = time
1699 iend(3) = 1
1700 call ncvgt( cdfid,id_data,istart,iend,data,rcode)
1702 if(debug) then
1703 write(unit=*, fmt='(a, i8)') ' Sample data=', data(1,1)
1704 endif
1706 call ncclos(cdfid,rcode)
1708 end subroutine get_var_2d_int_cdf
1710 !--------------------------------------------------------------------
1711 subroutine put_var_2d_int_cdf( file, var, data, &
1712 i1, i2, time, debug )
1714 implicit none
1716 include 'netcdf.inc'
1718 integer, intent(in) :: i1, i2, time
1719 character (len=80), intent(in) :: file
1720 logical, intent(in ) :: debug
1721 character (len=*), intent(in) :: var
1722 real, dimension(i1,i2), intent(in) :: data
1723 real(kind=8), dimension(i1,i2) :: tmp
1725 integer :: cdfid, rcode, id_data
1726 character (len=80) :: varnam, time1
1727 integer :: ndims, natts, idims(10), istart(10),iend(10), dimids(10)
1728 integer :: i, ivtype
1730 cdfid = ncopn(file, NCWRITE, rcode )
1732 if( rcode == 0) then
1733 if(debug) write(6,*) ' open netcdf file ', trim(file)
1734 else
1735 write(6,*) ' error openiing netcdf file ', trim(file)
1736 stop
1737 end if
1739 id_data = ncvid( cdfid, var, rcode )
1741 rcode = nf_inq_var( cdfid, id_data, varnam, ivtype, ndims, dimids, natts )
1742 if(debug) then
1743 write(6,*) ' number of dims for ',var,' ',ndims
1744 endif
1745 do i=1,ndims
1746 rcode = nf_inq_dimlen( cdfid, dimids(i), idims(i) )
1747 if(debug) write(6,*) ' dimension ',i,idims(i)
1748 enddo
1750 !---check the dimensions
1752 if((i1 /= idims(1)) .or. &
1753 (i2 /= idims(2)) .or. &
1754 (time > idims(3)) ) then
1756 write(6,*) ' error in 2d_var_real read, dimension problem '
1757 write(6,*) i1, idims(1)
1758 write(6,*) i2, idims(2)
1759 write(6,*) time, idims(3)
1760 write(6,*) ' error stop '
1761 stop
1762 end if
1764 !----get the data
1766 istart(1) = 1
1767 iend(1) = i1
1768 istart(2) = 1
1769 iend(2) = i2
1770 istart(3) = time
1771 iend(3) = 1
1772 call ncvpt( cdfid,id_data,istart,iend,data,rcode)
1774 if(debug) then
1775 write(unit=*, fmt='(a, i8)') ' Sample data=', data(1,1)
1776 endif
1778 call ncclos(cdfid,rcode)
1780 end subroutine put_var_2d_int_cdf
1781 !-------------------------------------------------------------------------------
1783 subroutine fill_nmm_grid2(gin,nx,ny,gout,igtype)
1784 use kinds, only: r_single,r_kind,i_kind
1785 use constants, only: quarter,half,zero
1786 use gridmod, only: iglobal,itotsub,ltosj,ltosi,ltosj_s,ltosi_s
1788 implicit none
1789 integer(i_kind) nx,ny,igtype
1790 ! real(r_single) gin(nx,ny),gout(2*nx-1,ny)
1791 real :: gin(nx,ny),gout(2*nx-1,ny)
1793 integer(i_kind) i,im,ip,j,jm,jp
1794 real(r_single) fill,test
1795 fill=0.95_r_kind*huge(fill) ; test=0.95_r_kind*fill
1796 do j=1,ny
1797 do i=1,2*nx-1
1798 gout(i,j)=fill
1799 end do
1800 end do
1802 ! First transfer all staggered points to appropriate
1803 ! points on filled output grid
1804 if(igtype.eq.1) then
1805 do j=1,ny,2
1806 do i=1,nx
1807 gout(2*i-1,j)=gin(i,j)
1808 end do
1810 end do
1811 do j=2,ny,2
1812 do i=1,nx-1
1813 gout(2*i,j)=gin(i,j)
1814 end do
1815 end do
1816 else
1817 do j=1,ny,2
1818 do i=1,nx-1
1819 gout(2*i,j)=gin(i,j)
1820 end do
1821 end do
1822 do j=2,ny,2
1823 do i=1,nx
1824 gout(2*i-1,j)=gin(i,j)
1825 end do
1826 end do
1827 end if
1829 ! Now fill in holes
1831 ! Top and bottom rows:
1832 do j=1,ny,ny-1
1833 do i=1,2*nx-1
1834 if(gout(i,j).gt.test) then
1835 ip=i+1 ; if(ip.gt.2*nx-1) ip=i-1
1836 im=i-1 ; if(im.lt.1) im=i+1
1837 gout(i,j)=half*(gout(im,j)+gout(ip,j))
1838 end if
1839 end do
1840 end do
1841 ! Left and right rows:
1842 do j=1,ny
1843 jp=j+1 ; if(jp.gt.ny) jp=j-1
1844 jm=j-1 ; if(jm.lt.1) jm=j+1
1845 do i=1,2*nx-1,2*nx-2
1846 if(gout(i,j).gt.test) gout(i,j)=half*(gout(i,jm)+gout(i,jp))
1847 end do
1848 end do
1850 ! Interior points
1851 do j=1,ny
1852 jp=j+1 ; if(jp.gt.ny) jp=j-1
1853 jm=j-1 ; if(jm.lt.1) jm=j+1
1854 do i=1,2*nx-1
1855 if(gout(i,j).gt.test) then
1856 ip=i+1 ; if(ip.gt.2*nx-1) ip=i-1
1857 im=i-1 ; if(im.lt.1) im=i+1
1858 gout(i,j)=quarter*(gout(ip,j)+gout(im,j)+gout(i,jp)+gout(i,jm))
1859 end if
1860 end do
1861 end do
1863 ! do j=1,ny
1864 ! print*,j,' gin max/min for lat ',j,maxval(gin(1:nx,j)),minval(gin(1:nx,j))
1865 ! print*,j,' gout max/min for lat ',j,maxval(gout(1:2*nx-1,j)),minval(gout(1:2*nx-1,j))
1866 ! end do
1868 ! do j=1,ny
1869 ! do i=1,nx
1870 ! print*, i, j, 'gin at (i,j) is ', gin(i,j)
1871 ! print*, i, j, 'gout at (i,j) is ', gout(i,j)
1872 ! end do
1873 ! print*,j,' gin max/min for lat ',j,maxval(gin(1:nx,j)),minval(gin(1:nx,j))
1874 ! print*,j,' gout max/min for lat ',j,maxval(gout(1:2*nx-1,j)),minval(gout(1:2*nx-1,j))
1875 ! end do
1877 return
1878 end subroutine fill_nmm_grid2
1879 !--------------------------------------------------------------------
1881 subroutine fill_nmm_grid3(gin,nx,ny,nz,gout,igtype)
1882 use kinds, only: r_single,r_kind,i_kind
1883 use constants, only: quarter,half,zero
1884 use gridmod, only: iglobal,itotsub,ltosj,ltosi,ltosj_s,ltosi_s
1886 implicit none
1887 integer(i_kind) nx,ny,nz,igtype
1888 ! real(r_single) gin(nx,ny),gout(2*nx-1,ny)
1889 real :: gin(nx,ny,nz),gout(2*nx-1,ny,nz)
1891 integer(i_kind) i,im,ip,j,jm,jp,k
1892 real(r_single) fill,test
1893 fill=0.95_r_kind*huge(fill) ; test=0.95_r_kind*fill
1894 do k=1,nz
1895 do j=1,ny
1896 do i=1,2*nx-1
1897 gout(i,j,k)=fill
1898 end do
1899 end do
1900 end do
1902 ! First transfer all staggered points to appropriate
1903 ! points on filled output grid
1904 if(igtype.eq.1) then
1905 do k=1,nz
1906 do j=1,ny,2
1907 do i=1,nx
1908 gout(2*i-1,j,k)=gin(i,j,k)
1909 end do
1911 end do
1912 do j=2,ny,2
1913 do i=1,nx-1
1914 gout(2*i,j,k)=gin(i,j,k)
1915 end do
1916 end do
1917 end do
1918 else
1919 do k=1,nz
1920 do j=1,ny,2
1921 do i=1,nx-1
1922 gout(2*i,j,k)=gin(i,j,k)
1923 end do
1924 end do
1925 do j=2,ny,2
1926 do i=1,nx
1927 gout(2*i-1,j,k)=gin(i,j,k)
1928 end do
1929 end do
1930 end do
1931 end if
1933 ! Now fill in holes
1935 ! Top and bottom rows:
1936 do k=1,nz
1937 do j=1,ny,ny-1
1938 do i=1,2*nx-1
1939 if(gout(i,j,k).gt.test) then
1940 ip=i+1 ; if(ip.gt.2*nx-1) ip=i-1
1941 im=i-1 ; if(im.lt.1) im=i+1
1942 gout(i,j,k)=half*(gout(im,j,k)+gout(ip,j,k))
1943 end if
1944 end do
1945 end do
1946 end do
1947 ! Left and right rows:
1948 do k=1,nz
1949 do j=1,ny
1950 jp=j+1 ; if(jp.gt.ny) jp=j-1
1951 jm=j-1 ; if(jm.lt.1) jm=j+1
1952 do i=1,2*nx-1,2*nx-2
1953 if(gout(i,j,k).gt.test) gout(i,j,k)=half*(gout(i,jm,k)+gout(i,jp,k))
1954 end do
1955 end do
1956 end do
1958 ! Interior points
1959 do k=1,nz
1960 do j=1,ny
1961 jp=j+1 ; if(jp.gt.ny) jp=j-1
1962 jm=j-1 ; if(jm.lt.1) jm=j+1
1963 do i=1,2*nx-1
1964 if(gout(i,j,k).gt.test) then
1965 ip=i+1 ; if(ip.gt.2*nx-1) ip=i-1
1966 im=i-1 ; if(im.lt.1) im=i+1
1967 gout(i,j,k)=quarter*(gout(ip,j,k)+gout(im,j,k)+gout(i,jp,k)+gout(i,jm,k))
1968 end if
1969 end do
1970 end do
1971 end do
1973 ! do j=1,ny
1974 ! print*,j,' gin max/min for lat ',j,maxval(gin(1:nx,j)),minval(gin(1:nx,j))
1975 ! print*,j,' gout max/min for lat ',j,maxval(gout(1:2*nx-1,j)),minval(gout(1:2*nx-1,j))
1976 ! end do
1978 return
1979 end subroutine fill_nmm_grid3
1980 !--------------------------------------------------------------------------------
1982 subroutine fill_arw_ugrid(gin,nx,ny,nz,gout)
1983 use kinds, only: r_single,r_kind,i_kind
1984 use constants, only: half
1986 implicit none
1987 integer(i_kind) nx,ny,nz
1988 real :: gin(nx,ny,nz),gout(nx+1,ny,nz)
1990 integer(i_kind) i,im,ip,j,jm,jp,k
1991 real(r_single) fill,test
1992 fill=0.95_r_kind*huge(fill) ; test=0.95_r_kind*fill
1993 do k=1,nz
1994 do j=1,ny
1995 do i=1,nx+1
1996 gout(i,j,k)=fill
1997 end do
1998 end do
1999 end do
2001 ! First transfer all staggered points to appropriate
2002 ! points on filled output grid
2003 do k=1,nz
2004 do j=1,ny
2005 do i=1,nx
2006 gout(i+1,j,k)=gin(i,j,k)
2007 end do
2008 end do
2009 end do
2011 ! Now fill in holes
2012 ! Left and right column:
2013 do k=1,nz
2014 do j=1,ny
2015 do i=1,nx+1,nx
2016 if((gout(i,j,k).gt.test) .and. (i .eq. 1)) then
2017 ip=i+1
2018 ! if(gout(i,j,k).gt.test) gout(i,j,k)=gout(ip,j,k)
2019 gout(i,j,k)=gout(ip,j,k)
2020 else if((gout(i,j,k).gt.test) .and. (i .eq. nx+1)) then
2021 im=i-1
2022 gout(i,j,k)=gout(im,j,k)
2023 end if
2024 end do
2025 end do
2026 end do
2028 ! Interior U-points:
2029 do k=1,nz
2030 do j=1,ny
2031 ! do i=2,nx
2032 do i=1,nx-1
2033 if(gout(i,j,k).lt.test) then
2034 ! ip=i ; if(ip.gt.nx) ip=i-1
2035 ip=i+1 ; if(ip.gt.nx) ip=i-1
2036 ! im=i-1 ; if(im.lt.1) im=i+1
2037 im=i ; if(im.lt.1) im=i+1
2038 ! gout(i,j,k)=half*(gout(im,j,k)+gout(ip,j,k))
2039 gout(i+1,j,k)=half*(gout(im,j,k)+gout(ip,j,k))
2040 ! gout(i+1,j,k)=half*(gout(i-1,j,k)+gout(i+1,j,k))
2041 end if
2042 end do
2043 end do
2044 end do
2046 return
2047 end subroutine fill_arw_ugrid
2048 !--------------------------------------------------------------------------------
2050 subroutine fill_arw_vgrid(gin,nx,ny,nz,gout)
2051 use kinds, only: r_single,r_kind,i_kind
2052 use constants, only: half
2054 implicit none
2055 integer(i_kind) nx,ny,nz
2056 real :: gin(nx,ny,nz),gout(nx,ny+1,nz)
2058 integer(i_kind) i,im,ip,j,jm,jp,k
2059 real(r_single) fill,test
2060 fill=0.95_r_kind*huge(fill) ; test=0.95_r_kind*fill
2061 do k=1,nz
2062 do j=1,ny+1
2063 do i=1,nx
2064 gout(i,j,k)=fill
2065 end do
2066 end do
2067 end do
2069 ! First transfer all staggered points to appropriate
2070 ! points on filled output grid
2071 do k=1,nz
2072 do j=1,ny
2073 do i=1,nx
2074 gout(i,j+1,k)=gin(i,j,k)
2075 end do
2076 end do
2077 end do
2079 ! Now fill in holes
2080 ! Bottom and top row:
2081 do k=1,nz
2082 do j=1,ny+1,ny
2083 do i=1,nx
2084 if((gout(i,j,k).gt.test) .and. (j .eq. 1)) then
2085 jp=j+1
2086 ! if(gout(i,j,k).gt.test) gout(i,j,k)=gout(ip,j,k)
2087 gout(i,j,k)=gout(i,jp,k)
2088 else if((gout(i,j,k).gt.test) .and. (j .eq. ny+1)) then
2089 jm=j-1
2090 gout(i,j,k)=gout(i,jm,k)
2091 end if
2092 end do
2093 end do
2094 end do
2096 ! Interior V-points:
2097 do k=1,nz
2098 do j=1,ny
2099 do i=1,nx
2100 if(gout(i,j,k).lt.test) then
2101 ! jp=j ; if(ip.gt.nx) ip=i-1
2102 jp=j+1 ; if(ip.gt.nx) ip=i-1
2103 ! jm=j-1 ; if(im.lt.1) im=i+1
2104 jm=j ; if(im.lt.1) im=i+1
2105 gout(i,j+1,k)=half*(gout(i,jm,k)+gout(i,jp,k))
2106 end if
2107 end do
2108 end do
2109 end do
2111 return
2112 end subroutine fill_arw_vgrid
2113 !--------------------------------------------------------------------------------
2115 subroutine fill_arw_xllu_grid(gin,nx,ny,gout)
2116 use kinds, only: r_single,r_kind,i_kind
2117 use constants, only: half
2119 implicit none
2120 integer(i_kind) nx,ny
2121 real :: gin(nx,ny),gout(nx+1,ny)
2123 integer(i_kind) i,im,ip,j,jm,jp
2124 real(r_single) fill,test
2125 fill=0.95_r_kind*huge(fill) ; test=0.95_r_kind*fill
2126 do j=1,ny
2127 do i=1,nx+1
2128 gout(i,j)=fill
2129 end do
2130 end do
2132 ! First transfer all staggered points to appropriate
2133 ! points on filled output grid
2134 do j=1,ny
2135 do i=1,nx
2136 gout(i+1,j)=gin(i,j)
2137 end do
2138 end do
2140 ! Now fill in holes
2141 ! Left and right column:
2142 do j=1,ny
2143 do i=1,nx+1,nx
2144 if((gout(i,j).gt.test) .and. (i .eq. 1)) then
2145 ip=i+1
2146 gout(i,j)=gout(ip,j)
2147 else if((gout(i,j).gt.test) .and. (i .eq. nx+1)) then
2148 im=i-1
2149 gout(i,j)=gout(im,j)
2150 end if
2151 end do
2152 end do
2154 ! Interior U-points:
2155 do j=1,ny
2156 do i=1,nx-1
2157 if(gout(i,j).lt.test) then
2158 ip=i+1 ; if(ip.gt.nx) ip=i-1
2159 im=i ; if(im.lt.1) im=i+1
2160 gout(i+1,j)=half*(gout(im,j)+gout(ip,j))
2161 end if
2162 end do
2163 end do
2165 return
2166 end subroutine fill_arw_xllu_grid
2167 !--------------------------------------------------------------------------------
2169 subroutine fill_arw_xllv_grid(gin,nx,ny,gout)
2170 use kinds, only: r_single,r_kind,i_kind
2171 use constants, only: half
2173 implicit none
2174 integer(i_kind) nx,ny
2175 real :: gin(nx,ny),gout(nx,ny+1)
2177 integer(i_kind) i,im,ip,j,jm,jp
2178 real(r_single) fill,test
2179 fill=0.95_r_kind*huge(fill) ; test=0.95_r_kind*fill
2180 do j=1,ny+1
2181 do i=1,nx
2182 gout(i,j)=fill
2183 end do
2184 end do
2186 ! First transfer all staggered points to appropriate
2187 ! points on filled output grid
2188 do j=1,ny
2189 do i=1,nx
2190 gout(i,j+1)=gin(i,j)
2191 end do
2192 end do
2194 ! Now fill in holes
2195 ! Bottom and top row:
2196 do j=1,ny+1,ny
2197 do i=1,nx
2198 if((gout(i,j).gt.test) .and. (j .eq. 1)) then
2199 jp=j+1
2200 gout(i,j)=gout(i,jp)
2201 else if((gout(i,j).gt.test) .and. (j .eq. ny+1)) then
2202 jm=j-1
2203 gout(i,j)=gout(i,jm)
2204 end if
2205 end do
2206 end do
2208 ! Interior V-points:
2209 do j=1,ny
2210 do i=1,nx
2211 if(gout(i,j).lt.test) then
2212 jp=j+1 ; if(ip.gt.nx) ip=i-1
2213 jm=j ; if(im.lt.1) im=i+1
2214 gout(i,j+1)=half*(gout(i,jm)+gout(i,jp))
2215 end if
2216 end do
2217 end do
2219 return
2220 end subroutine fill_arw_xllv_grid