Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

write_ncheader_v3.f90 @ 16

Last change on this file since 16 was 16, checked in by jebri, 10 years ago
sources for flexwrf v3.1
File size: 31.2 KB

Line
1	!***********************************************************************
2	!* Copyright 2012,2013 *
3	!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine, *
4	!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
5	!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso, *
6	!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann, *
7	!* Adam Dingwell *
8	!* *
9	!* This file is part of FLEXPART WRF *
10	! *
11	! FLEXPART is free software: you can redistribute it and/or modify *
12	! it under the terms of the GNU General Public License as published by*
13	! the Free Software Foundation, either version 3 of the License, or *
14	! (at your option) any later version. *
15	! *
16	! FLEXPART is distributed in the hope that it will be useful, *
17	! but WITHOUT ANY WARRANTY; without even the implied warranty of *
18	! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *
19	! GNU General Public License for more details. *
20	! *
21	! You should have received a copy of the GNU General Public License *
22	! along with FLEXPART. If not, see <http://www.gnu.org/licenses/>. *
23	!**********************************************************************
24
25	subroutine write_ncheader(itime,nesting_level)
26
27	!*****************************************************************************
28	! *
29	! This routine perdefines a netcdf ouput file with information on flexpart *
30	! settings, releases and topography. *
31	! *
32	! Author: A. Dingwell *
33	! *
34	! 27 May 2013 *
35	! *
36	! Modifications *
37	! June 5 2013: J. Brioude: generate a headernc
38	!*****************************************************************************
39
40	use point_mod
41	use outg_mod
42	use com_mod
43
44	implicit none
45
46	include 'netcdf.inc'
47
48	integer :: itime,stat ! seconds since simulation start
49	integer :: nesting_level ! 0 for main grid (mother) 1 for nest (child)
50	! this is written to be easy to expand is additional
51	! are desired in the future
52
53	real(kind=dp) :: jul ! Julian date
54	integer :: jjjjmmdd,ihmmss ! date & time as integer
55	character :: adate8,atime6 ! date and time strings, used for filename
56
57	! Grid related variables
58	real :: xp1,yp1,xp2,yp2 ! temporary coordinates
59	real :: xsw,xne,ysw,yne,tmpx,tmpy,tmplon,tmplat,xl2,yl2
60	integer :: ncgrid_nx,ncgrid_ny ! nx,ny of current grid
61	integer :: ncgrid_dx,ncgrid_dy ! dx,dy of current grid in m or latlon
62	real :: ncgrid_swlon,ncgrid_swlat ! SW corner of current grid in latlon
63	real :: ncgrid_nelon,ncgrid_nelat ! NE corner of current grid in latlon
64	real :: ncgrid_xm0,ncgrid_ym0 ! lower-left grid coord in metres
65	real :: ncgrid_lon0,ncgrid_lat0 ! lower-left grid coord in latlon
66
67	! Grid related 2D-variables (reassigning these here is a bit inefficient but
68	! it lets us keep a consistent structure of the code, besides it's only once
69	! per output
70	real,allocatable,dimension (:,:) :: ncgrid_oro,ncgrid_area ! of current grid
71
72	! Iterators
73	integer i,j,ix,jy
74
75	! NETCDF file related variables
76	integer nclvlid,nclonid,nclatid,ncrecid,ncspcid,ncageid !outgrid dimension ids
77	integer ncrelid,ncrseid ! release points dimension ids
78	integer ncrnvid,ncrmvid,ncspvid ! release points: number,mass,species ids
79	integer ncrtvid,ncrxvid,ncryvid,ncrzvid ! release points: t,x,y,z min/max limits
80	integer nctovid,ncarvid ! Topography and grid area variable-ids
81	integer ncstr1id,ncstr2id,ncstr3id ! decrtiption string length dimid
82	integer nclvlvid,nclonvid,nclatvid,ncspcvid,ncagevid ! outgrid dimension variables
83	integer nclonvid2,nclatvid2
84	integer ncdimsid3(6),ncdimsid2(5) ! arrays of dimension ids for outgrid 3D & 2D
85
86	! NETCDF filename & attribute related variables
87	character descr11,units5,ncname29,coord11,coordxy*10
88	integer coordxylen
89	character unit2d*10 ! unit for deposition fields
90	integer unit2dlen ! length of character string
91
92	! NETCDF misc variables
93	integer ncid ! local container for netcdf file-id (either ncout or ncoutn)
94	integer ncret ! Return-value of calls to nf_* utils
95	integer :: deflate_level=1 ! compression level
96	integer :: shuffle=1 ! shuffle
97	! integer :: chunks(2) ! shuffle
98	! Attribute notation:
99	descr = 'description'
100	units = 'units'
101	coord = 'coordinates'
102	coordxy = 'XLONG XLAT'
103	coordxylen = 10
104
105	! Determine current calendar date, needed for the file name
106	!**********************************************************
107	jul=bdate+real(itime,kind=dp)/86400._dp
108	call caldate(jul,jjjjmmdd,ihmmss)
109	write(adate,'(i8.8)') jjjjmmdd
110	write(atime,'(i6.6)') ihmmss
111
112	!************************
113	! Open header output file
114	!************************
115	! write(ncname,'(A8,I2.2,A1,I8.8,A1,I6.6,A3)') &
116	! 'flxout_d',nesting_level+1,'_',jjjjmmdd,'_',ihmmss,'.nc' ! filename
117	write(ncname,'(A8,I2.2,A3)') &
118	'header_d',nesting_level+1,'.nc' ! filename
119
120
121	! call nf_set_log_level(3)
122	if (option_verbose.ge.1) write(,) &
123	'write_ncheader: creating file: ',path(1)(1:length(1))//ncname
124	! call nf_set_chunk_cache(32000000)
125	ncret = nf_create(path(1)(1:length(1))//ncname, nf_clobber,ncid)
126	! ncret = nf_create(path(1)(1:length(1))//ncname, NF_NETCDF4,ncid)
127	call check_ncerror(ncret)
128
129	! Determine which nest/outfile we just created so we can set up the grid
130	!***********************************************************************
131	if (nesting_level.eq.0) then ! current grid is main grid
132	ncout = ncid ! copy current file handle to ncout
133	ncgrid_nx = numxgrid
134	ncgrid_ny = numygrid
135	ncgrid_nelon = outgrid_nelon
136	ncgrid_nelat = outgrid_nelat
137	ncgrid_swlon = outgrid_swlon
138	ncgrid_swlat = outgrid_swlat
139	allocate(ncgrid_oro(ncgrid_nx,ncgrid_ny),stat=stat)
140	allocate(ncgrid_area(ncgrid_nx,ncgrid_ny),stat=stat)
141	ncgrid_oro = oroout(0:ncgrid_nx-1,0:ncgrid_ny-1)
142	ncgrid_area = area(0:ncgrid_nx-1,0:ncgrid_ny-1)
143	if (outgrid_option.eq.1) then ! input was in latlon
144	ncgrid_dx = dxoutl
145	ncgrid_dy = dyoutl
146	ncgrid_lon0 = outlon0
147	ncgrid_lat0 = outlat0
148	else ! input was in metres
149	ncgrid_dx = dxout
150	ncgrid_dy = dyout
151	ncgrid_xm0 = out_xm0
152	ncgrid_ym0 = out_ym0
153	endif
154	elseif (nesting_level.eq.1) then ! current grid is nested
155	ncoutn = ncid ! copy current file handle to ncoutn
156	ncgrid_nx = numxgridn
157	ncgrid_ny = numygridn
158	ncgrid_nelon = outgridn_nelon
159	ncgrid_nelat = outgridn_nelat
160	ncgrid_swlon = outgridn_swlon
161	ncgrid_swlat = outgridn_swlat
162	allocate(ncgrid_oro(ncgrid_nx,ncgrid_ny),stat=stat)
163	allocate(ncgrid_area(ncgrid_nx,ncgrid_ny),stat=stat)
164	ncgrid_oro = orooutn(0:ncgrid_nx-1,0:ncgrid_ny-1)
165	ncgrid_area = arean(0:ncgrid_nx-1,0:ncgrid_ny-1)
166	if (outgrid_option.eq.1) then ! input was in latlon
167	ncgrid_dx = dxoutln
168	ncgrid_dy = dyoutln
169	ncgrid_lon0 = outlon0n
170	ncgrid_lat0 = outlat0n
171	else ! input was in metres
172	ncgrid_dx = dxoutn
173	ncgrid_dy = dyoutn
174	ncgrid_xm0 = out_xm0n
175	ncgrid_ym0 = out_ym0n
176	endif
177	endif
178
179	if (option_verbose.ge.10) &
180	write(,) 'write_ncheader: ncout,ncoutn=',ncout,ncoutn
181
182	! Write the header information
183	!*****************************
184
185	!ncret = nf_put_att_text(ncout,nf_global,'TITLE',20,version)
186	!call check_ncerror(ncret)
187	if (ldirect.eq.1) then ! Forward simulation
188	if (option_verbose.ge.10) write(*,10) 'forward simulation attributes'
189	ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_START_DATE',nf_int,1,ibdate)
190	call check_ncerror(ncret)
191	ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_START_TIME',nf_int,1,ibtime)
192	call check_ncerror(ncret)
193
194	ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_END_DATE',nf_int,1,iedate)
195	call check_ncerror(ncret)
196	ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_END_TIME',nf_int,1,ietime)
197	call check_ncerror(ncret)
198	else ! Backward simulation
199	if (option_verbose.ge.10) write(*,10) 'backward simulation attributes'
200	ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_START_DATE',nf_int,1,iedate)
201	call check_ncerror(ncret)
202	ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_START_TIME',nf_int,1,ietime)
203	call check_ncerror(ncret)
204
205	ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_END_DATE',nf_int,1,ibdate)
206	call check_ncerror(ncret)
207	ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_END_TIME',nf_int,1,ibtime)
208	call check_ncerror(ncret)
209	endif
210
211	if (option_verbose.ge.10) write(*,10) 'map projection attributes'
212	if (outgrid_option .eq. 1) then
213	ncret = &
214	nf_put_att_text(ncid,nf_global,'OUTPUT_PROJECTION',20,'Regular Latit/Longit')
215	call check_ncerror(ncret)
216	else
217	if (map_proj_id.eq.1) then
218	ncret = &
219	nf_put_att_text(ncid,nf_global,'OUTPUT_PROJECTION',17,'Lambert conformal')
220	call check_ncerror(ncret)
221	elseif (map_proj_id.eq.2) then
222	ncret = &
223	nf_put_att_text(ncid,nf_global,'OUTPUT_PROJECTION',13,'stereographic')
224	call check_ncerror(ncret)
225	elseif (map_proj_id.eq.3) then
226	ncret = &
227	nf_put_att_text(ncid,nf_global,'OUTPUT_PROJECTION',8,'mercator')
228	call check_ncerror(ncret)
229	elseif (map_proj_id.eq.4) then
230	ncret = &
231	nf_put_att_text(ncid,nf_global,'OUTPUT_PROJECTION',6,'global')
232	call check_ncerror(ncret)
233	endif
234	endif
235
236	! Write info common model settings
237	!*********************************
238	if (option_verbose.ge.10) write(*,10) 'common model attributes'
239
240	if (option_verbose.ge.10) write(*,10) 'OUTPUT_INTERVAL'
241	ncret = nf_put_att_int(ncid,nf_global,'OUTPUT_INTERVAL',nf_int,1,loutstep)
242	call check_ncerror(ncret)
243
244	if (option_verbose.ge.10) write(*,10) 'AVERAGING_TIME'
245	ncret = nf_put_att_int(ncid,nf_global,'AVERAGING_TIME',nf_int,1,loutaver)
246	call check_ncerror(ncret)
247
248	if (option_verbose.ge.10) write(*,10) 'AVERAGE_SAMPLING'
249	ncret = nf_put_att_int(ncid,nf_global,'AVERAGE_SAMPLING',nf_int,1,loutsample)
250	call check_ncerror(ncret)
251
252	ncret = nf_put_att_int(ncid,nf_global,'NSPEC',nf_int,1,nspec)
253	call check_ncerror(ncret)
254	ncret = nf_put_att_int(ncid,nf_global,'NUMRECEPTOR',nf_int,1,numreceptor)
255	call check_ncerror(ncret)
256	ncret = nf_put_att_int(ncid,nf_global,'NAGECLASS',nf_int,1,nageclass)
257	call check_ncerror(ncret)
258
259	ncret = nf_put_att_int(ncid,nf_global,'NUMRELEASES',nf_int,1,numpoint)
260	call check_ncerror(ncret)
261
262	ncret = nf_put_att_int(ncid,nf_global,'DISPERSION_METHOD',nf_int,1,method)
263	call check_ncerror(ncret)
264
265	ncret = nf_put_att_int(ncid,nf_global,'SUBGRID_TOPOGRAPHY',nf_int,1,lsubgrid)
266	call check_ncerror(ncret)
267
268	ncret = nf_put_att_int(ncid,nf_global,'CONVECTION_PARAM',nf_int,1,lconvection)
269	call check_ncerror(ncret)
270
271	ncret = nf_put_att_int(ncid,nf_global,'SUBGRID_TOPOGRAPHY',nf_int,1,lsubgrid)
272	call check_ncerror(ncret)
273
274	! Write information on output grid setup
275	!***************************************
276	if (option_verbose.ge.10) write(*,10) 'WEST-EAST_GRID_DIMENSION'
277	ncret = nf_put_att_int(ncid,nf_global,'WEST-EAST_GRID_DIMENSION', &
278	nf_int,1,ncgrid_nx)
279	call check_ncerror(ncret)
280
281	if (option_verbose.ge.10) write(*,10) 'SOUTH-NORTH_GRID_DIMENSION'
282	ncret = nf_put_att_int(ncid,nf_global,'SOUTH-NORTH_GRID_DIMENSION', &
283	nf_int,1,ncgrid_ny)
284	call check_ncerror(ncret)
285
286	if (option_verbose.ge.10) write(*,10) 'BOTTOM-TOP_GRID_DIMENSION'
287	ncret = nf_put_att_int(ncid,nf_global,'BOTTOM-TOP_GRID_DIMENSION', &
288	nf_int,1,numzgrid)
289
290	if (option_verbose.ge.10) write(*,10) 'DX and DY'
291	ncret = nf_put_att_int(ncid,nf_global,'DX',nf_int,1,ncgrid_dx)
292	call check_ncerror(ncret)
293
294	ncret = nf_put_att_int(ncid,nf_global,'DY',nf_int,1,ncgrid_dy)
295	call check_ncerror(ncret)
296
297	! Set up netcdf dimensions
298	!*************************
299	if (option_verbose.ge.10) write(*,10) 'main grid dimensions'
300
301	ncret = nf_def_dim(ncid,'Time',nf_unlimited,ncrecid)
302	call check_ncerror(ncret)
303
304	ncret = nf_def_dim(ncid,'DateStrLen',15,ncstr3id) !TODO: WRF format
305	call check_ncerror(ncret)
306
307	ncret = nf_def_dim(ncid,'west_east',ncgrid_nx,nclonid)
308	call check_ncerror(ncret)
309
310	ncret = nf_def_dim(ncid,'south_north',ncgrid_ny,nclatid)
311	call check_ncerror(ncret)
312
313	ncret = nf_def_dim(ncid,'bottom_top',numzgrid,nclvlid)
314	call check_ncerror(ncret)
315
316	ncret = nf_def_dim(ncid,'species',nspec,ncspcid)
317	call check_ncerror(ncret)
318
319	ncret = nf_def_dim(ncid,'SpeciesStrLen',10,ncstr1id)
320	call check_ncerror(ncret)
321
322	ncret = nf_def_dim(ncid,'ageclass',nageclass,ncageid)
323	call check_ncerror(ncret)
324
325	if (option_verbose.ge.10) write(*,10) 'release point dimensions'
326	ncret = nf_def_dim(ncid,'releases',numpoint,ncrelid)
327	call check_ncerror(ncret)
328
329	ncret = nf_def_dim(ncid,'ReleaseStrLen',45,ncstr2id)
330	call check_ncerror(ncret)
331
332	ncret = nf_def_dim(ncid,'ReleaseStartEnd',2,ncrseid)
333	call check_ncerror(ncret)
334
335	! Select which dimensions to use for main output grids
336	ncdimsid3(1) = nclonid ! X
337	ncdimsid3(2) = nclatid ! Y
338	ncdimsid3(3) = nclvlid ! Z
339	if (ldirect.eq.1) ncdimsid3(4) = ncspcid ! species
340	if (ldirect.eq.-1) ncdimsid3(4) = ncrelid ! points
341	ncdimsid3(5) = ncageid ! ageclass
342	ncdimsid3(6) = ncrecid ! t
343
344	ncdimsid2(1) = nclonid ! X
345	ncdimsid2(2) = nclatid ! Y
346	if (ldirect.eq.1) ncdimsid2(3) = ncspcid ! species
347	if (ldirect.eq.-1) ncdimsid2(3) = ncrelid ! points
348	ncdimsid2(4) = ncageid ! ageclass
349	ncdimsid2(5) = ncrecid ! t
350
351	! Set up dimension variables
352	!***************************
353
354	! XLONG
355	if (option_verbose.ge.10) write(*,10) 'XLONG dimension variable'
356	ncret = nf_def_var(ncid,'XLONG',nf_real,2,ncdimsid2(1:2),nclonvid)
357
358	! Turn on deflate compression, fletcher32 checksum.
359	! ncret = NF_DEF_VAR_deflate(ncid,nclonvid, shuffle, 1, deflate_level)
360	! if (ncret .ne. nf_noerr) call handle_err(retval)
361	! ncret = NF_DEF_VAR_FLETCHER32(ncid, nclonvid, NF_FLETCHER32)
362	! if (ncret .ne. nf_noerr) call handle_err(retval)
363
364	! ncret = nf_def_var_deflate(ncid,'XLONG',nf_real,2,ncdimsid2(1:2),nclonvid,deflate_level=deflate_level)
365
366	call check_ncerror(ncret)
367	ncret = nf_put_att_text(ncid,nclonvid,descr,42,'Longitude of center grid, west is negative')
368	call check_ncerror(ncret)
369	ncret = nf_put_att_text(ncid,nclonvid,units,11,'degree_east')
370	call check_ncerror(ncret)
371
372	ncret = nf_def_var(ncid,'XLONG_CORNER',nf_real,2,ncdimsid2(1:2),nclonvid2)
373	call check_ncerror(ncret)
374	ncret = nf_put_att_text(ncid,nclonvid2,descr,57,'Longitude of lower left corner of grids, west is negative')
375	call check_ncerror(ncret)
376	ncret = nf_put_att_text(ncid,nclonvid2,units,11,'degree_east')
377	call check_ncerror(ncret)
378
379
380	! XLAT
381	if (option_verbose.ge.10) write(*,10) 'XLAT dimension variable'
382	ncret = nf_def_var(ncid,'XLAT',nf_real,2,ncdimsid2(1:2),nclatvid)
383	! ncret = nf_def_var_deflate(ncid,'XLAT',nf_real,2,ncdimsid2(1:2),nclatvid,deflate_level=deflate_level)
384	! ncret = NF_DEF_VAR_deflate(ncid,nclatvid, shuffle, 1, deflate_level)
385	call check_ncerror(ncret)
386	ncret = nf_put_att_text(ncid,nclatvid,descr,42,'Latitude of center grid, south is negative')
387	call check_ncerror(ncret)
388	ncret = nf_put_att_text(ncid,nclatvid,units,12,'degree_north')
389	call check_ncerror(ncret)
390
391	ncret = nf_def_var(ncid,'XLAT_CORNER',nf_real,2,ncdimsid2(1:2),nclatvid2)
392	call check_ncerror(ncret)
393	ncret = nf_put_att_text(ncid,nclatvid2,descr,57,'Latitude of lower left corner of grids, south is negative')
394	call check_ncerror(ncret)
395	ncret = nf_put_att_text(ncid,nclatvid2,units,12,'degree_north')
396	call check_ncerror(ncret)
397
398	! ZTOP
399	if (option_verbose.ge.10) write(*,10) 'ZTOP dimension variable'
400	ncret = nf_def_var(ncid,'ZTOP',nf_real,1,ncdimsid3(3),nclvlvid)
401	! ncret = NF_DEF_VAR_deflate(ncid,nclvlvid, shuffle, 1, deflate_level)
402	call check_ncerror(ncret)
403	ncret = nf_put_att_text(ncid,nclvlvid,descr,32, &
404	'UPPER BOUNDARY OF MODEL LAYER')
405	call check_ncerror(ncret)
406	ncret = nf_put_att_text(ncid,nclvlvid,units,1,'m')
407	call check_ncerror(ncret)
408
409	! SPECIES
410	if (option_verbose.ge.10) write(*,10) 'SPECIES dimension variable'
411	ncret = nf_def_var(ncid,'SPECIES',nf_char,2,(/ncstr1id,ncspcid/),ncspcvid)
412	! ncret = NF_DEF_VAR_deflate(ncid,ncspcvid, shuffle, 1, deflate_level)
413	call check_ncerror(ncret)
414	ncret = nf_put_att_text(ncid,ncspcvid,descr,15,'NAME OF SPECIES')
415	call check_ncerror(ncret)
416
417	! AGECLASSES
418	if (option_verbose.ge.10) write(*,10) 'AGECLASSES dimension variable'
419	ncret = nf_def_var(ncid,'AGECLASS',nf_int,1,ncageid,ncagevid)
420	! ncret = NF_DEF_VAR_deflate(ncid,ncagevid, shuffle, 1, deflate_level)
421	call check_ncerror(ncret)
422	ncret = nf_put_att_text(ncid,ncagevid,descr,27,'MAX AGE OF SPECIES IN CLASS')
423	call check_ncerror(ncret)
424	ncret = nf_put_att_text(ncid,ncagevid,units,1,'s')
425	call check_ncerror(ncret)
426
427	! TIMES
428	if (option_verbose.ge.10) write(*,10) 'TIMES dimension variable'
429	ncret = nf_def_var(ncid,'Times',nf_char,2,(/ncstr3id,ncrecid/),ncrecvid)
430	! ncret = NF_DEF_VAR_deflate(ncid,ncrecvid, shuffle, 1, deflate_level)
431	call check_ncerror(ncret)
432	ncret = nf_put_att_text(ncid,ncrecvid,descr,42, &
433	'TIME OF OUTPUT (END OF AVERAGING INTERVAL)')
434
435	! Release related variables
436	if (option_verbose.ge.10) write(*,10) 'ReleaseName variable'
437	ncret = nf_def_var(ncid,'ReleaseName',nf_char,2,(/ncstr2id,ncrelid/),ncrnvid)
438	! ncret = NF_DEF_VAR_deflate(ncid,ncrnvid, shuffle, 1, deflate_level)
439	call check_ncerror(ncret)
440	ncret = nf_put_att_text(ncid,ncrnvid,descr,25,'RELEASE IDENTIFIER/COMMENT')
441	call check_ncerror(ncret)
442	ncret = nf_put_att_text(ncid,ncrnvid,units,1,'-')
443	call check_ncerror(ncret)
444
445	if (option_verbose.ge.10) write(*,10) 'ReleaseTstart_end variable'
446	ncret = nf_def_var(ncid,'ReleaseTstart_end', &
447	nf_int,2,(/ncrseid,ncrelid/),ncrtvid)
448	! ncret = NF_DEF_VAR_deflate(ncid,ncrtvid, shuffle, 1, deflate_level)
449	call check_ncerror(ncret)
450	ncret = nf_put_att_text(ncid,ncrtvid,descr,32, &
451	'BEGINNING/ENDING TIME OF RELEASE (SECONDS SINCE RUN START)')
452	call check_ncerror(ncret)
453	ncret = nf_put_att_text(ncid,ncrtvid,units,1,'s')
454	call check_ncerror(ncret)
455
456	if (option_verbose.ge.10) write(*,10) 'ReleaseXstart_end variable'
457	ncret = nf_def_var(ncid,'ReleaseXstart_end', &
458	nf_float,2,(/ncrseid,ncrelid/),ncrxvid)
459	! ncret = NF_DEF_VAR_deflate(ncid,ncrxvid, shuffle, 1, deflate_level)
460	call check_ncerror(ncret)
461	ncret = nf_put_att_text(ncid,ncrxvid,descr,32, &
462	'WEST/EAST BOUNDARIES OF SOURCE')
463	call check_ncerror(ncret)
464	ncret = nf_put_att_text(ncid,ncrxvid,units,12,'degree_north')
465	call check_ncerror(ncret)
466
467	if (option_verbose.ge.10) write(*,10) 'ReleaseYstart_end variable'
468	ncret = nf_def_var(ncid,'ReleaseYstart_end', &
469	nf_float,2,(/ncrseid,ncrelid/),ncryvid)
470	! ncret = NF_DEF_VAR_deflate(ncid,ncryvid, shuffle, 1, deflate_level)
471	call check_ncerror(ncret)
472	ncret = nf_put_att_text(ncid,ncryvid,descr,32, &
473	'SOUTH/NORTH BOUNDARIES OF SOURCE')
474	call check_ncerror(ncret)
475	ncret = nf_put_att_text(ncid,ncryvid,units,12,'degree_north')
476	call check_ncerror(ncret)
477
478	if (option_verbose.ge.10) write(*,10) 'ReleaseZstart_end variable'
479	ncret = nf_def_var(ncid,'ReleaseZstart_end', &
480	nf_float,2,(/ncrseid,ncrelid/),ncrzvid)
481	! ncret = NF_DEF_VAR_deflate(ncid,ncrzvid, shuffle, 1, deflate_level)
482	call check_ncerror(ncret)
483	ncret = nf_put_att_text(ncid,ncrzvid,descr,31, &
484	'BOTTOM/TOP BOUNDARIES OF SOURCE')
485	call check_ncerror(ncret)
486	ncret = nf_put_att_text(ncid,ncrzvid,units,1,'m')
487	call check_ncerror(ncret)
488
489	if (option_verbose.ge.10) write(*,10) 'ReleaseNP variable'
490	ncret = nf_def_var(ncid,'ReleaseNP',nf_int,1,ncrelid,ncspvid)
491	! ncret = NF_DEF_VAR_deflate(ncid,ncspvid, shuffle, 1, deflate_level)
492	call check_ncerror(ncret)
493	ncret = nf_put_att_text(ncid,ncspvid,descr,34, &
494	'TOTAL NUMBER OF PARTICLES RELEASED')
495	ncret = nf_put_att_text(ncid,ncspvid,units,1,'-')
496	call check_ncerror(ncret)
497
498	if (option_verbose.ge.10) write(*,10) 'ReleaseXMass variable'
499	ncret = nf_def_var(ncid,'ReleaseXMass',nf_real,2,(/ncspcid,ncrelid/),ncrmvid)
500	! ncret = NF_DEF_VAR_deflate(ncid,ncrmvid, shuffle, 1, deflate_level)
501	call check_ncerror(ncret)
502	ncret = nf_put_att_text(ncid,ncrmvid,descr,18,'TOTAL MASS RELEASED')
503	call check_ncerror(ncret)
504	ncret = nf_put_att_text(ncid,ncrmvid,units,2,'kg')
505	call check_ncerror(ncret)
506
507	! Since we need to exit define mode before we can insert
508	! variable data, we will include the last file attributes and
509	! define the last variables here.
510
511	! DIRECTION INDEPENDENT OUTPUT VARIABLES
512	if (option_verbose.ge.10) write(*,10) 'TOPOGRAPHY variable'
513	ncret = nf_def_var(ncid,'TOPOGRAPHY',NF_real,2,ncdimsid2(1:2),nctovid)
514	! ncret = nf_def_var_deflate(ncid,'TOPOGRAPHY',NF_real,2,ncdimsid2(1:2),nctovid,deflate_level=deflate_level)
515	! ncret = NF_DEF_VAR_deflate(ncid,nctovid, shuffle, 1, deflate_level)
516	call check_ncerror(ncret)
517	ncret = nf_put_att_text(ncid,nctovid,descr,33, &
518	'TERRAIN ELEVATION ABOVE SEA LEVEL')
519	call check_ncerror(ncret)
520	ncret = nf_put_att_text(ncid,nctovid,units,1,'m')
521	call check_ncerror(ncret)
522	ncret = nf_put_att_text(ncid,nctovid,coord,coordxylen,coordxy)
523	call check_ncerror(ncret)
524
525	if (option_verbose.ge.10) write(*,10) 'GRIDAREA variable'
526	ncret = nf_def_var(ncid,'GRIDAREA',NF_real,2,ncdimsid2(1:2),ncarvid)
527	! ncret = nf_def_var_deflate(ncid,'GRIDAREA',NF_real,2,ncdimsid2(1:2),ncarvid,deflate_level=deflate_level)
528	! ncret = NF_DEF_VAR_deflate(ncid,ncarvid, shuffle, 1, deflate_level)
529	call check_ncerror(ncret)
530	ncret = nf_put_att_text(ncid,ncarvid,descr,30, &
531	'SURFACE AREA OF EACH GRID CELL')
532	call check_ncerror(ncret)
533	ncret = nf_put_att_text(ncid,ncarvid,units,2,'m2')
534	call check_ncerror(ncret)
535	ncret = nf_put_att_text(ncid,ncarvid,coord,coordxylen,coordxy)
536	call check_ncerror(ncret)
537
538	! MAIN OUTPUT VARIABLES
539	! if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then ! CONCENTRATION
540	! if (option_verbose.ge.10) write(*,10) 'CONC variable'
541	! ncret = nf_def_var(ncid,'CONC',NF_REAL,6,ncdimsid3,nccovid)
542	!! chunks(1) = ncgrid_nx
543	!! chunks(2) = ncgrid_ny
544	!!! ncret = NF_DEF_VAR_CHUNKING(ncid, nccovid, NF_CHUNKED, chunks)
545	!! if (ncret .ne. nf_noerr) call check_ncerror(ncret)
546	! ncret = NF_DEF_VAR_deflate(ncid,nccovid, shuffle, 1, deflate_level)
547	!
548	! call check_ncerror(ncret)
549	! ncret = nf_put_att_text(ncid,nccovid,descr,33, &
550	! 'CONCENTRATION OF AIRBORNE SPECIES')
551	! call check_ncerror(ncret)
552	! ncret = nf_put_att_text(ncid,nccovid,coord,coordxylen,coordxy)
553	! call check_ncerror(ncret)
554	! endif
555
556	! if ((iout.eq.2).or.(iout.eq.3)) then ! MIXING RATIO
557	! if (option_verbose.ge.10) write(*,10) 'MIXINGRATIO variable'
558	! ncret = nf_def_var(ncid,'MIXINGRATIO',NF_REAL,6,ncdimsid3,ncravid)
559	! ncret = NF_DEF_VAR_deflate(ncid,ncravid, shuffle, 1, deflate_level)
560	! call check_ncerror(ncret)
561	! ncret = nf_put_att_text(ncid,ncravid,descr,37, &
562	! 'MASS MIXING RATIO OF AIRBORNE SPECIES')
563	! call check_ncerror(ncret)
564	! ncret = nf_put_att_text(ncid,ncravid,coord,coordxylen,coordxy)
565	! call check_ncerror(ncret)
566	! endif
567	!
568	! if (ldirect.eq.1) then ! Forward run
569	! unit2d = 'pg m-2'
570	! unit2dlen = 6
571	!
572	! if (option_verbose.ge.10) write(*,10) 'DRYDEP variable'
573	! write(,) ncdimsid2
574	! ncret = nf_def_var(ncid,'DRYDEP',NF_REAL,5,ncdimsid2,ncddvid)
575	! ncret = NF_DEF_VAR_deflate(ncid,ncddvid, shuffle, 1, deflate_level)
576	! call check_ncerror(ncret)
577	! ncret = nf_put_att_text(ncid,ncddvid,descr,32, &
578	! 'ACCUMULATED TOTAL DRY DEPOSITION')
579	! call check_ncerror(ncret)
580	! ncret = nf_put_att_text(ncid,ncddvid,units,unit2dlen,unit2d)
581	! call check_ncerror(ncret)
582	! ncret = nf_put_att_text(ncid,ncddvid,coord,coordxylen,coordxy)
583	! call check_ncerror(ncret)
584	!
585	! if (option_verbose.ge.10) write(*,10) 'WETDEP variable'
586	! ncret = nf_def_var(ncid,'WETDEP',NF_REAL,5,ncdimsid2,ncwdvid)
587	! ncret = NF_DEF_VAR_deflate(ncid,ncwdvid, shuffle, 1, deflate_level)
588	! call check_ncerror(ncret)
589	! ncret = nf_put_att_text(ncid,ncwdvid,descr,32, &
590	! 'ACCUMULATED TOTAL WET DEPOSITION')
591	! call check_ncerror(ncret)
592	! ncret = nf_put_att_text(ncid,ncwdvid,units,unit2dlen,unit2d)
593	! call check_ncerror(ncret)
594	! ncret = nf_put_att_text(ncid,ncwdvid,coord,coordxylen,coordxy)
595	! call check_ncerror(ncret)
596	!
597	! ! Add unit attr to mixing ratio and concentration fields
598	! ncret = nf_put_att_text(ncid,nccovid,units,6,'ng m-3') !CONC
599	! call check_ncerror(ncret)
600	! ncret = nf_put_att_text(ncid,ncravid,units,3,'ppt') !MIX
601	! call check_ncerror(ncret)
602	! else ! Backward run
603	! if (ind_rel.eq.1) then ! release in mass
604	! write(,) 'A'
605	! !Concentration field should be in 's' (?)
606	! ncret = nf_put_att_text(ncid,nccovid,units,1,'s') !CONC
607	! !call check_ncerror(ncret)
608	! !Mixing ratio field should be in 's kg m-3' (?)
609	! !ncret = nf_put_att_text(ncid,ncravid,units,8,'s kg m-3') !RATIO
610	! !call check_ncerror(ncret)
611	! else ! release in mass mix
612	! !Concentration should be in 's m3 kg-1' (?)
613	! write(,) 'B'
614	! ncret = nf_put_att_text(ncid,nccovid,units,9,'s m3 kg-1') !CONC
615	! !call check_ncerror(ncret)
616	! !Mixing ratio should be in 's' (?)
617	! ncret = nf_put_att_text(ncid,ncravid,units,1,'s') !RATIO
618	! !call check_ncerror(ncret)
619	! endif
620	! endif ! Backward/Forward run
621
622	! EXIT DEFINE MODE, ENTER DATA MODE
623	ncret = nf_enddef(ncid)
624	call check_ncerror(ncret)
625
626	! DIMENSION VARIABLES
627	if (option_verbose.ge.10) write(*,10) 'ZTOP data'
628	ncret = nf_put_var_real(ncid,nclvlvid,outheight)
629	call check_ncerror(ncret)
630
631	! X,Y - Lon,Lat
632	if (option_verbose.ge.10) write(*,10) 'XLAT,XLONG data'
633
634	if (outgrid_option.eq.0) then ! irregular
635	do jy=1,ncgrid_ny
636	do ix=1,ncgrid_nx
637	tmpx=ncgrid_xm0+(float(ix)-0.5)*ncgrid_dx
638	tmpy=ncgrid_ym0+(float(jy)-0.5)*ncgrid_dy
639	call xymeter_to_ll_wrf(tmpx,tmpy,tmplon,tmplat)
640	ncret = nf_put_vara_real(ncid,nclonvid,(/ix,jy/),(/1,1/),tmplon)
641	call check_ncerror(ncret)
642	ncret = nf_put_vara_real(ncid,nclatvid,(/ix,jy/),(/1,1/),tmplat)
643	call check_ncerror(ncret)
644	tmpx=ncgrid_xm0+(float(ix)-1.)*ncgrid_dx
645	tmpy=ncgrid_ym0+(float(jy)-1.)*ncgrid_dy
646	call xymeter_to_ll_wrf(tmpx,tmpy,tmplon,tmplat)
647	ncret = nf_put_vara_real(ncid,nclonvid2,(/ix,jy/),(/1,1/),tmplon)
648	call check_ncerror(ncret)
649	ncret = nf_put_vara_real(ncid,nclatvid2,(/ix,jy/),(/1,1/),tmplat)
650	call check_ncerror(ncret)
651	enddo
652	enddo
653	else
654	do jy=1,ncgrid_ny
655	do ix=1,ncgrid_nx
656	call ll_to_xymeter_wrf(ncgrid_swlon,ncgrid_swlat,xsw,ysw)
657	call ll_to_xymeter_wrf(ncgrid_nelon,ncgrid_nelat,xne,yne)
658	tmpx=xsw+(xne-xsw)*float(ix-1)/float(ncgrid_nx-1)
659	tmpy=ysw+(yne-ysw)*float(jy-1)/float(ncgrid_ny-1)
660	call xymeter_to_ll_wrf(tmpx,tmpy,tmplon,tmplat)
661	xl2=ncgrid_lon0+(float(ix)-0.5)*dxoutl !long
662	yl2=ncgrid_lat0+(float(jy)-0.5)*dyoutl !lat
663	ncret = nf_put_vara_real(ncid,nclonvid,(/ix,jy/),(/1,1/),xl2)
664	call check_ncerror(ncret)
665	ncret = nf_put_vara_real(ncid,nclatvid,(/ix,jy/),(/1,1/),yl2)
666	call check_ncerror(ncret)
667	xl2=ncgrid_lon0+(float(ix)-1.)*dxoutl !long
668	yl2=ncgrid_lat0+(float(jy)-1.)*dyoutl !lat
669	ncret = nf_put_vara_real(ncid,nclonvid2,(/ix,jy/),(/1,1/),xl2)
670	call check_ncerror(ncret)
671	ncret = nf_put_vara_real(ncid,nclatvid2,(/ix,jy/),(/1,1/),yl2)
672	call check_ncerror(ncret)
673
674	enddo
675	enddo
676	endif ! outgrid_option
677
678
679	! Write information on release points: total number, then for each point:
680	! start, end, coordinates, # of particles, name, mass
681	!************************************************************************
682	do i=1,numpoint
683	xp1=xpoint1(i)*dx+xlon0 ! This is probably wrong, but it seems to be
684	yp1=ypoint1(i)dy+ylat0 ! the same in writeheader.f90, so I'll leave
685	xp2=xpoint2(i)*dx+xlon0 ! it for now... //AD
686	yp2=ypoint2(i)*dy+ylat0 !
687
688	if (option_verbose.ge.10) write(*,10) 'ReleaseTstart_end data'
689	ncret = nf_put_vara_int(ncid,ncrtvid, & ! ReleaseTstart_end
690	(/1,i/),(/2,1/),(/ireleasestart(i),ireleaseend(i)/))
691	call check_ncerror(ncret)
692
693	if (option_verbose.ge.10) write(*,10) 'ReleaseXstart_end data'
694	ncret = nf_put_vara_real(ncid,ncrxvid, & ! ReleaseXstart_end
695	(/1,i/),(/2,1/),(/xp1,xp2/))
696	call check_ncerror(ncret)
697
698	if (option_verbose.ge.10) write(*,10) 'ReleaseYstart_end data'
699	ncret = nf_put_vara_real(ncid,ncryvid, & !ReleaseYstart_end
700	(/1,i/),(/2,1/),(/yp1,yp2/))
701	call check_ncerror(ncret)
702
703	if (option_verbose.ge.10) write(*,10) 'ReleaseZstart_end data'
704	ncret = nf_put_vara_real(ncid,ncrzvid, & !ReleaseZstart_end
705	(/1,i/),(/2,1/),(/zpoint1(i),zpoint2(i)/))
706	call check_ncerror(ncret)
707
708	if (option_verbose.ge.10) write(*,10) 'ReleaseXMass data'
709	ncret = nf_put_vara_real(ncid,ncrmvid, & !ReleaseXMass
710	(/1,i/),(/nspec,1/),xmass(i,1:nspec))
711	call check_ncerror(ncret)
712
713	if (option_verbose.ge.10) write(*,10) 'ReleaseNP data'
714	ncret = nf_put_vara_int(ncid,ncspvid, & !ReleaseNP
715	i,1,npart(i))
716	call check_ncerror(ncret)
717
718	!Release Name/Comment
719	j=1 ! Find the length of each release point comment/name
720	do while( j.lt.45.and.compoint(i)(j+1:j+1).ne." ")
721	j=j+1
722	enddo
723	if (option_verbose.ge.10) write(*,10) 'ReleaseName data'
724	ncret = nf_put_vara_text(ncid,ncrnvid,(/1,i/),(/j,1/),compoint(i)(1:j))
725	call check_ncerror(ncret)
726	enddo
727
728	! Write age class information
729	!****************************
730	if (option_verbose.ge.10) write(*,10) 'AGECLASSES data'
731	ncret = nf_put_var_int(ncid,ncagevid,lage(1:nageclass))
732	call check_ncerror(ncret)
733
734	! Write topography to output file
735	!********************************
736	if (option_verbose.ge.10) write(*,10) 'TOPOGRAPHY data'
737	! do ix=0,ncgrid_nx-1
738	do ix=1,ncgrid_nx
739	ncret = nf_put_vara_real(ncid,nctovid, &
740	! (/ix+1,1/),(/1,ncgrid_ny/),ncgrid_oro(ix,0:ncgrid_ny-1))
741	(/ix,1/),(/1,ncgrid_ny/),ncgrid_oro(ix,1:ncgrid_ny))
742	call check_ncerror(ncret)
743	enddo
744
745	! Write grid cell surface area
746	!*****************************
747	if (option_verbose.ge.10) write(*,10) 'GRIDAREA data'
748	! do ix=0,ncgrid_nx-1
749	do ix=1,ncgrid_nx
750	ncret = nf_put_vara_real(ncid,ncarvid, &
751	! (/ix+1,1/),(/1,ncgrid_ny/),ncgrid_area(ix,0:ncgrid_ny-1))
752	(/ix,1/),(/1,ncgrid_ny/),ncgrid_area(ix,1:ncgrid_ny))
753	call check_ncerror(ncret)
754	enddo
755
756	! SAVE CREATED NETCDF TO FILE
757	!****************************
758	if (option_verbose.ge.1) write(,) 'write_ncheader: writing to disk'
759	ncret = nf_sync(ncid)
760	call check_ncerror(ncret)
761
762	return
763
764	10 format('write_ncheader: Setting up ',A)
765
766	ncret=nf_close(ncid)
767	deallocate(ncgrid_oro,ncgrid_area)
768	end subroutine write_ncheader

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format