Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

write_ncinfo.f90 @ 16

Last change on this file since 16 was 16, checked in by jebri, 11 years ago
sources for flexwrf v3.1
File size: 31.7 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_ncinfo(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: Create and write attributes to netcdf output only *
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 ncdimsid3(6),ncdimsid2(5) ! arrays of dimension ids for outgrid 3D & 2D
84	integer ncdimsid32(7),ncdimsid22(6) ! 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=4 ! compression level
96	integer :: shuffle=0 ! 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
118	! print*,'step0',itime,jjjjmmdd,ihmmss
119
120	! call nf_set_log_level(3)
121	if (option_verbose.ge.1) write(,) &
122	'write_ncinfo: creating file: ',path(1)(1:length(1))//ncname
123	! call nf_set_chunk_cache(32000000)
124	! ncret = nf_create(path(1)(1:length(1))//ncname, nf_clobber,ncid)
125	ncret = nf_create(path(1)(1:length(1))//ncname, NF_NETCDF4,ncid)
126	! print*,'step1',ncret
127	call check_ncerror(ncret)
128
129
130	! Determine which nest/outfile we just created so we can set up the grid
131	!***********************************************************************
132	if (nesting_level.eq.0) then ! current grid is main grid
133	ncout = ncid ! copy current file handle to ncout
134	ncgrid_nx = numxgrid
135	ncgrid_ny = numygrid
136	ncgrid_nelon = outgrid_nelon
137	ncgrid_nelat = outgrid_nelat
138	ncgrid_swlon = outgrid_swlon
139	ncgrid_swlat = outgrid_swlat
140	! allocate(ncgrid_oro(ncgrid_nx,ncgrid_ny),stat=stat)
141	! allocate(ncgrid_area(ncgrid_nx,ncgrid_ny),stat=stat)
142	! ncgrid_oro = oroout(0:ncgrid_nx-1,0:ncgrid_ny-1)
143	! ncgrid_area = area(0:ncgrid_nx-1,0:ncgrid_ny-1)
144	! print*,'step2'
145	if (outgrid_option.eq.1) then ! input was in latlon
146	ncgrid_dx = dxoutl
147	ncgrid_dy = dyoutl
148	ncgrid_lon0 = outlon0
149	ncgrid_lat0 = outlat0
150	else ! input was in metres
151	ncgrid_dx = dxout
152	ncgrid_dy = dyout
153	ncgrid_xm0 = out_xm0
154	ncgrid_ym0 = out_ym0
155	endif
156	elseif (nesting_level.eq.1) then ! current grid is nested
157	ncoutn = ncid ! copy current file handle to ncoutn
158	ncgrid_nx = numxgridn
159	ncgrid_ny = numygridn
160	ncgrid_nelon = outgridn_nelon
161	ncgrid_nelat = outgridn_nelat
162	ncgrid_swlon = outgridn_swlon
163	ncgrid_swlat = outgridn_swlat
164	! allocate(ncgrid_oro(ncgrid_nx,ncgrid_ny),stat=stat)
165	! allocate(ncgrid_area(ncgrid_nx,ncgrid_ny),stat=stat)
166	! ncgrid_oro = orooutn(0:ncgrid_nx-1,0:ncgrid_ny-1)
167	! ncgrid_area = arean(0:ncgrid_nx-1,0:ncgrid_ny-1)
168	if (outgrid_option.eq.1) then ! input was in latlon
169	ncgrid_dx = dxoutln
170	ncgrid_dy = dyoutln
171	ncgrid_lon0 = outlon0n
172	ncgrid_lat0 = outlat0n
173	else ! input was in metres
174	ncgrid_dx = dxoutn
175	ncgrid_dy = dyoutn
176	ncgrid_xm0 = out_xm0n
177	ncgrid_ym0 = out_ym0n
178	endif
179	endif
180	! print*,'step3'
181
182	if (option_verbose.ge.10) &
183	write(,) 'write_ncheader: ncout,ncoutn=',ncout,ncoutn
184
185	! Write the header information
186	!*****************************
187
188	!ncret = nf_put_att_text(ncout,nf_global,'TITLE',20,version)
189	!call check_ncerror(ncret)
190	! print*,'continue'
191	if (ldirect.eq.1) then ! Forward simulation
192	if (option_verbose.ge.10) write(*,10) 'forward simulation attributes'
193	ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_START_DATE',nf_int,1,ibdate)
194	call check_ncerror(ncret)
195	ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_START_TIME',nf_int,1,ibtime)
196	call check_ncerror(ncret)
197
198	ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_END_DATE',nf_int,1,iedate)
199	call check_ncerror(ncret)
200	ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_END_TIME',nf_int,1,ietime)
201	call check_ncerror(ncret)
202	else ! Backward simulation
203	if (option_verbose.ge.10) write(*,10) 'backward simulation attributes'
204	ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_START_DATE',nf_int,1,iedate)
205	call check_ncerror(ncret)
206	ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_START_TIME',nf_int,1,ietime)
207	call check_ncerror(ncret)
208
209	ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_END_DATE',nf_int,1,ibdate)
210	call check_ncerror(ncret)
211	ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_END_TIME',nf_int,1,ibtime)
212	call check_ncerror(ncret)
213	endif
214
215	if (option_verbose.ge.10) write(*,10) 'map projection attributes'
216	if (outgrid_option .eq. 1) then
217	ncret = &
218	nf_put_att_text(ncid,nf_global,'OUTPUT_PROJECTION',20,'Regular Latit/Longit')
219	call check_ncerror(ncret)
220	else
221	if (map_proj_id.eq.1) then
222	ncret = &
223	nf_put_att_text(ncid,nf_global,'OUTPUT_PROJECTION',17,'Lambert conformal')
224	call check_ncerror(ncret)
225	elseif (map_proj_id.eq.2) then
226	ncret = &
227	nf_put_att_text(ncid,nf_global,'OUTPUT_PROJECTION',13,'stereographic')
228	call check_ncerror(ncret)
229	elseif (map_proj_id.eq.3) then
230	ncret = &
231	nf_put_att_text(ncid,nf_global,'OUTPUT_PROJECTION',8,'mercator')
232	call check_ncerror(ncret)
233	elseif (map_proj_id.eq.4) then
234	ncret = &
235	nf_put_att_text(ncid,nf_global,'OUTPUT_PROJECTION',6,'global')
236	call check_ncerror(ncret)
237	endif
238	endif
239
240	! Write info common model settings
241	!*********************************
242	if (option_verbose.ge.10) write(*,10) 'common model attributes'
243
244	if (option_verbose.ge.10) write(*,10) 'OUTPUT_INTERVAL'
245	ncret = nf_put_att_int(ncid,nf_global,'OUTPUT_INTERVAL',nf_int,1,loutstep)
246	call check_ncerror(ncret)
247
248	if (option_verbose.ge.10) write(*,10) 'AVERAGING_TIME'
249	ncret = nf_put_att_int(ncid,nf_global,'AVERAGING_TIME',nf_int,1,loutaver)
250	call check_ncerror(ncret)
251
252	if (option_verbose.ge.10) write(*,10) 'AVERAGE_SAMPLING'
253	ncret = nf_put_att_int(ncid,nf_global,'AVERAGE_SAMPLING',nf_int,1,loutsample)
254	call check_ncerror(ncret)
255
256	ncret = nf_put_att_int(ncid,nf_global,'NSPEC',nf_int,1,nspec)
257	call check_ncerror(ncret)
258	ncret = nf_put_att_int(ncid,nf_global,'NUMRECEPTOR',nf_int,1,numreceptor)
259	call check_ncerror(ncret)
260	ncret = nf_put_att_int(ncid,nf_global,'NAGECLASS',nf_int,1,nageclass)
261	call check_ncerror(ncret)
262
263	ncret = nf_put_att_int(ncid,nf_global,'NUMRELEASES',nf_int,1,numpoint)
264	call check_ncerror(ncret)
265
266	ncret = nf_put_att_int(ncid,nf_global,'DISPERSION_METHOD',nf_int,1,method)
267	call check_ncerror(ncret)
268
269	ncret = nf_put_att_int(ncid,nf_global,'SUBGRID_TOPOGRAPHY',nf_int,1,lsubgrid)
270	call check_ncerror(ncret)
271
272	ncret = nf_put_att_int(ncid,nf_global,'CONVECTION_PARAM',nf_int,1,lconvection)
273	call check_ncerror(ncret)
274
275	ncret = nf_put_att_int(ncid,nf_global,'SUBGRID_TOPOGRAPHY',nf_int,1,lsubgrid)
276	call check_ncerror(ncret)
277
278	! Write information on output grid setup
279	!***************************************
280	if (option_verbose.ge.10) write(*,10) 'WEST-EAST_GRID_DIMENSION'
281	ncret = nf_put_att_int(ncid,nf_global,'WEST-EAST_GRID_DIMENSION', &
282	nf_int,1,ncgrid_nx)
283	call check_ncerror(ncret)
284
285	if (option_verbose.ge.10) write(*,10) 'SOUTH-NORTH_GRID_DIMENSION'
286	ncret = nf_put_att_int(ncid,nf_global,'SOUTH-NORTH_GRID_DIMENSION', &
287	nf_int,1,ncgrid_ny)
288	call check_ncerror(ncret)
289
290	if (option_verbose.ge.10) write(*,10) 'BOTTOM-TOP_GRID_DIMENSION'
291	ncret = nf_put_att_int(ncid,nf_global,'BOTTOM-TOP_GRID_DIMENSION', &
292	nf_int,1,numzgrid)
293
294	if (option_verbose.ge.10) write(*,10) 'DX and DY'
295	ncret = nf_put_att_int(ncid,nf_global,'DX',nf_int,1,ncgrid_dx)
296	call check_ncerror(ncret)
297
298	ncret = nf_put_att_int(ncid,nf_global,'DY',nf_int,1,ncgrid_dy)
299	call check_ncerror(ncret)
300
301	! Set up netcdf dimensions
302	!*************************
303	if (option_verbose.ge.10) write(*,10) 'main grid dimensions'
304
305	ncret = nf_def_dim(ncid,'Time',nf_unlimited,ncrecid)
306	call check_ncerror(ncret)
307
308	ncret = nf_def_dim(ncid,'DateStrLen',15,ncstr3id) !TODO: WRF format
309	call check_ncerror(ncret)
310
311	ncret = nf_def_dim(ncid,'west_east',ncgrid_nx,nclonid)
312	call check_ncerror(ncret)
313
314	ncret = nf_def_dim(ncid,'south_north',ncgrid_ny,nclatid)
315	call check_ncerror(ncret)
316
317	ncret = nf_def_dim(ncid,'bottom_top',numzgrid,nclvlid)
318	call check_ncerror(ncret)
319
320	ncret = nf_def_dim(ncid,'species',nspec,ncspcid)
321	call check_ncerror(ncret)
322
323	ncret = nf_def_dim(ncid,'SpeciesStrLen',10,ncstr1id)
324	call check_ncerror(ncret)
325
326	ncret = nf_def_dim(ncid,'ageclass',nageclass,ncageid)
327	call check_ncerror(ncret)
328
329	if (option_verbose.ge.10) write(*,10) 'release point dimensions'
330	ncret = nf_def_dim(ncid,'releases',numpoint,ncrelid)
331	call check_ncerror(ncret)
332
333	ncret = nf_def_dim(ncid,'ReleaseStrLen',45,ncstr2id)
334	call check_ncerror(ncret)
335
336	ncret = nf_def_dim(ncid,'ReleaseStartEnd',2,ncrseid)
337	call check_ncerror(ncret)
338
339	! Select which dimensions to use for main output grids
340	if ((ldirect.eq.1).and.(maxpointspec_act.gt.1)) then
341	ncdimsid32(1) = nclonid ! X
342	ncdimsid32(2) = nclatid ! Y
343	ncdimsid32(3) = nclvlid ! Z
344	ncdimsid32(4) = ncrelid ! points
345	ncdimsid32(5) = ncspcid ! species
346	ncdimsid32(6) = ncageid ! ageclass
347	ncdimsid32(7) = ncrecid ! t
348
349	ncdimsid22(1) = nclonid ! X
350	ncdimsid22(2) = nclatid ! Y
351	ncdimsid22(3) = ncrelid ! points
352	ncdimsid22(4) = ncspcid ! species
353	ncdimsid22(5) = ncageid ! ageclass
354	ncdimsid22(6) = ncrecid ! t
355
356	else
357	ncdimsid3(1) = nclonid ! X
358	ncdimsid3(2) = nclatid ! Y
359	ncdimsid3(3) = nclvlid ! Z
360	if (ldirect.eq.1) ncdimsid3(4) = ncspcid ! species
361	if (ldirect.eq.-1) ncdimsid3(4) = ncrelid ! points
362	ncdimsid3(5) = ncageid ! ageclass
363	ncdimsid3(6) = ncrecid ! t
364
365	ncdimsid2(1) = nclonid ! X
366	ncdimsid2(2) = nclatid ! Y
367	if (ldirect.eq.1) ncdimsid2(3) = ncspcid ! species
368	if (ldirect.eq.-1) ncdimsid2(3) = ncrelid ! points
369	ncdimsid2(4) = ncageid ! ageclass
370	ncdimsid2(5) = ncrecid ! t
371	endif
372	!
373	! ! Set up dimension variables
374	! !***************************
375	!
376	! ! XLONG
377	! if (option_verbose.ge.10) write(*,10) 'XLONG dimension variable'
378	! ncret = nf_def_var(ncid,'XLONG',nf_real,2,ncdimsid2(1:2),nclonvid)
379	!
380	!! Turn on deflate compression, fletcher32 checksum.
381	! ncret = NF_DEF_VAR_deflate(ncid,nclonvid, shuffle, 1, deflate_level)
382	!! if (ncret .ne. nf_noerr) call handle_err(retval)
383	!! ncret = NF_DEF_VAR_FLETCHER32(ncid, nclonvid, NF_FLETCHER32)
384	!! if (ncret .ne. nf_noerr) call handle_err(retval)
385	!
386	!! ncret = nf_def_var_deflate(ncid,'XLONG',nf_real,2,ncdimsid2(1:2),nclonvid,deflate_level=deflate_level)
387	! call check_ncerror(ncret)
388	! ncret = nf_put_att_text(ncid,nclonvid,descr,27,'LONGITUDE, WEST IS NEGATIVE')
389	! call check_ncerror(ncret)
390	! ncret = nf_put_att_text(ncid,nclonvid,units,11,'degree_east')
391	! call check_ncerror(ncret)
392	!
393	! ! XLAT
394	! if (option_verbose.ge.10) write(*,10) 'XLAT dimension variable'
395	! ncret = nf_def_var(ncid,'XLAT',nf_real,2,ncdimsid2(1:2),nclatvid)
396	!! ncret = nf_def_var_deflate(ncid,'XLAT',nf_real,2,ncdimsid2(1:2),nclatvid,deflate_level=deflate_level)
397	! ncret = NF_DEF_VAR_deflate(ncid,nclatvid, shuffle, 1, deflate_level)
398	! call check_ncerror(ncret)
399	! ncret = nf_put_att_text(ncid,nclatvid,descr,27,'LATITUDE, SOUTH IS NEGATIVE')
400	! call check_ncerror(ncret)
401	! ncret = nf_put_att_text(ncid,nclatvid,units,12,'degree_north')
402	! call check_ncerror(ncret)
403	!
404	! ! ZTOP
405	! if (option_verbose.ge.10) write(*,10) 'ZTOP dimension variable'
406	! ncret = nf_def_var(ncid,'ZTOP',nf_real,1,ncdimsid3(3),nclvlvid)
407	! ncret = NF_DEF_VAR_deflate(ncid,nclvlvid, shuffle, 1, deflate_level)
408	! call check_ncerror(ncret)
409	! ncret = nf_put_att_text(ncid,nclvlvid,descr,32, &
410	! 'UPPER BOUNDARY OF MODEL LAYER')
411	! call check_ncerror(ncret)
412	! ncret = nf_put_att_text(ncid,nclvlvid,units,1,'m')
413	! call check_ncerror(ncret)
414	!
415	! ! SPECIES
416	! if (option_verbose.ge.10) write(*,10) 'SPECIES dimension variable'
417	! ncret = nf_def_var(ncid,'SPECIES',nf_char,2,(/ncstr1id,ncspcid/),ncspcvid)
418	! ncret = NF_DEF_VAR_deflate(ncid,ncspcvid, shuffle, 1, deflate_level)
419	! call check_ncerror(ncret)
420	! ncret = nf_put_att_text(ncid,ncspcvid,descr,15,'NAME OF SPECIES')
421	! call check_ncerror(ncret)
422	!
423	! ! AGECLASSES
424	! if (option_verbose.ge.10) write(*,10) 'AGECLASSES dimension variable'
425	! ncret = nf_def_var(ncid,'AGECLASS',nf_int,1,ncageid,ncagevid)
426	! ncret = NF_DEF_VAR_deflate(ncid,ncagevid, shuffle, 1, deflate_level)
427	! call check_ncerror(ncret)
428	! ncret = nf_put_att_text(ncid,ncagevid,descr,27,'MAX AGE OF SPECIES IN CLASS')
429	! call check_ncerror(ncret)
430	! ncret = nf_put_att_text(ncid,ncagevid,units,1,'s')
431	! call check_ncerror(ncret)
432	!
433	! ! TIMES
434	if (option_verbose.ge.10) write(*,10) 'TIMES dimension variable'
435	ncret = nf_def_var(ncid,'Times',nf_char,2,(/ncstr3id,ncrecid/),ncrecvid)
436	ncret = NF_DEF_VAR_deflate(ncid,ncrecvid, shuffle, 1, deflate_level)
437	call check_ncerror(ncret)
438	ncret = nf_put_att_text(ncid,ncrecvid,descr,42, &
439	'TIME OF OUTPUT (END OF AVERAGING INTERVAL)')
440	!
441	! ! Release related variables
442	! if (option_verbose.ge.10) write(*,10) 'ReleaseName variable'
443	! ncret = nf_def_var(ncid,'ReleaseName',nf_char,2,(/ncstr2id,ncrelid/),ncrnvid)
444	! ncret = NF_DEF_VAR_deflate(ncid,ncrnvid, shuffle, 1, deflate_level)
445	! call check_ncerror(ncret)
446	! ncret = nf_put_att_text(ncid,ncrnvid,descr,25,'RELEASE IDENTIFIER/COMMENT')
447	! call check_ncerror(ncret)
448	! ncret = nf_put_att_text(ncid,ncrnvid,units,1,'-')
449	! call check_ncerror(ncret)
450	!
451	! if (option_verbose.ge.10) write(*,10) 'ReleaseTstart_end variable'
452	! ncret = nf_def_var(ncid,'ReleaseTstart_end', &
453	! nf_int,2,(/ncrseid,ncrelid/),ncrtvid)
454	! ncret = NF_DEF_VAR_deflate(ncid,ncrtvid, shuffle, 1, deflate_level)
455	! call check_ncerror(ncret)
456	! ncret = nf_put_att_text(ncid,ncrtvid,descr,32, &
457	! 'BEGINNING/ENDING TIME OF RELEASE (SECONDS SINCE RUN START)')
458	! call check_ncerror(ncret)
459	! ncret = nf_put_att_text(ncid,ncrtvid,units,1,'s')
460	! call check_ncerror(ncret)
461	!
462	! if (option_verbose.ge.10) write(*,10) 'ReleaseXstart_end variable'
463	! ncret = nf_def_var(ncid,'ReleaseXstart_end', &
464	! nf_float,2,(/ncrseid,ncrelid/),ncrxvid)
465	! ncret = NF_DEF_VAR_deflate(ncid,ncrxvid, shuffle, 1, deflate_level)
466	! call check_ncerror(ncret)
467	! ncret = nf_put_att_text(ncid,ncrxvid,descr,32, &
468	! 'WEST/EAST BOUNDARIES OF SOURCE')
469	! call check_ncerror(ncret)
470	! ncret = nf_put_att_text(ncid,ncrxvid,units,12,'degree_north')
471	! call check_ncerror(ncret)
472	!
473	! if (option_verbose.ge.10) write(*,10) 'ReleaseYstart_end variable'
474	! ncret = nf_def_var(ncid,'ReleaseYstart_end', &
475	! nf_float,2,(/ncrseid,ncrelid/),ncryvid)
476	! ncret = NF_DEF_VAR_deflate(ncid,ncryvid, shuffle, 1, deflate_level)
477	! call check_ncerror(ncret)
478	! ncret = nf_put_att_text(ncid,ncryvid,descr,32, &
479	! 'SOUTH/NORTH BOUNDARIES OF SOURCE')
480	! call check_ncerror(ncret)
481	! ncret = nf_put_att_text(ncid,ncryvid,units,12,'degree_north')
482	! call check_ncerror(ncret)
483	!
484	! if (option_verbose.ge.10) write(*,10) 'ReleaseZstart_end variable'
485	! ncret = nf_def_var(ncid,'ReleaseZstart_end', &
486	! nf_float,2,(/ncrseid,ncrelid/),ncrzvid)
487	! ncret = NF_DEF_VAR_deflate(ncid,ncrzvid, shuffle, 1, deflate_level)
488	! call check_ncerror(ncret)
489	! ncret = nf_put_att_text(ncid,ncrzvid,descr,31, &
490	! 'BOTTOM/TOP BOUNDARIES OF SOURCE')
491	! call check_ncerror(ncret)
492	! ncret = nf_put_att_text(ncid,ncrzvid,units,1,'m')
493	! call check_ncerror(ncret)
494	!
495	! if (option_verbose.ge.10) write(*,10) 'ReleaseNP variable'
496	! ncret = nf_def_var(ncid,'ReleaseNP',nf_int,1,ncrelid,ncspvid)
497	! ncret = NF_DEF_VAR_deflate(ncid,ncspvid, shuffle, 1, deflate_level)
498	! call check_ncerror(ncret)
499	! ncret = nf_put_att_text(ncid,ncspvid,descr,34, &
500	! 'TOTAL NUMBER OF PARTICLES RELEASED')
501	! ncret = nf_put_att_text(ncid,ncspvid,units,1,'-')
502	! call check_ncerror(ncret)
503	!
504	! if (option_verbose.ge.10) write(*,10) 'ReleaseXMass variable'
505	! ncret = nf_def_var(ncid,'ReleaseXMass',nf_real,2,(/ncspcid,ncrelid/),ncrmvid)
506	! ncret = NF_DEF_VAR_deflate(ncid,ncrmvid, shuffle, 1, deflate_level)
507	! call check_ncerror(ncret)
508	! ncret = nf_put_att_text(ncid,ncrmvid,descr,18,'TOTAL MASS RELEASED')
509	! call check_ncerror(ncret)
510	! ncret = nf_put_att_text(ncid,ncrmvid,units,2,'kg')
511	! call check_ncerror(ncret)
512	!
513	! ! Since we need to exit define mode before we can insert
514	! ! variable data, we will include the last file attributes and
515	! ! define the last variables here.
516	!
517	! ! DIRECTION INDEPENDENT OUTPUT VARIABLES
518	! if (option_verbose.ge.10) write(*,10) 'TOPOGRAPHY variable'
519	! ncret = nf_def_var(ncid,'TOPOGRAPHY',NF_real,2,ncdimsid2(1:2),nctovid)
520	!! ncret = nf_def_var_deflate(ncid,'TOPOGRAPHY',NF_real,2,ncdimsid2(1:2),nctovid,deflate_level=deflate_level)
521	! ncret = NF_DEF_VAR_deflate(ncid,nctovid, shuffle, 1, deflate_level)
522	! call check_ncerror(ncret)
523	! ncret = nf_put_att_text(ncid,nctovid,descr,33, &
524	! 'TERRAIN ELEVATION ABOVE SEA LEVEL')
525	! call check_ncerror(ncret)
526	! ncret = nf_put_att_text(ncid,nctovid,units,1,'m')
527	! call check_ncerror(ncret)
528	! ncret = nf_put_att_text(ncid,nctovid,coord,coordxylen,coordxy)
529	! call check_ncerror(ncret)
530	!
531	! if (option_verbose.ge.10) write(*,10) 'GRIDAREA variable'
532	! ncret = nf_def_var(ncid,'GRIDAREA',NF_real,2,ncdimsid2(1:2),ncarvid)
533	!! ncret = nf_def_var_deflate(ncid,'GRIDAREA',NF_real,2,ncdimsid2(1:2),ncarvid,deflate_level=deflate_level)
534	! ncret = NF_DEF_VAR_deflate(ncid,ncarvid, shuffle, 1, deflate_level)
535	! call check_ncerror(ncret)
536	! ncret = nf_put_att_text(ncid,ncarvid,descr,30, &
537	! 'SURFACE AREA OF EACH GRID CELL')
538	! call check_ncerror(ncret)
539	! ncret = nf_put_att_text(ncid,ncarvid,units,2,'m2')
540	! call check_ncerror(ncret)
541	! ncret = nf_put_att_text(ncid,ncarvid,coord,coordxylen,coordxy)
542	! call check_ncerror(ncret)
543	!
544	! MAIN OUTPUT VARIABLES
545	if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then ! CONCENTRATION
546	if (option_verbose.ge.10) write(*,10) 'CONC variable'
547	! print*,ncdimsid3
548	if ((ldirect.eq.1).and.(maxpointspec_act.gt.1)) then
549	ncret = nf_def_var(ncid,'CONC',NF_REAL,7,ncdimsid32,nccovid)
550	else
551	ncret = nf_def_var(ncid,'CONC',NF_REAL,6,ncdimsid3,nccovid)
552	endif
553	! chunks(1) = ncgrid_nx
554	! chunks(2) = ncgrid_ny
555	!! ncret = NF_DEF_VAR_CHUNKING(ncid, nccovid, NF_CHUNKED, chunks)
556	if (ncret .ne. nf_noerr) call check_ncerror(ncret)
557	ncret = NF_DEF_VAR_deflate(ncid,nccovid, shuffle, 1, deflate_level)
558
559	call check_ncerror(ncret)
560	ncret = nf_put_att_text(ncid,nccovid,descr,33, &
561	'CONCENTRATION OF AIRBORNE SPECIES')
562	call check_ncerror(ncret)
563	ncret = nf_put_att_text(ncid,nccovid,coord,coordxylen,coordxy)
564	call check_ncerror(ncret)
565	endif
566
567	if ((iout.eq.2).or.(iout.eq.3)) then ! MIXING RATIO
568	if (option_verbose.ge.10) write(*,10) 'MIXINGRATIO variable'
569	if ((ldirect.eq.1).and.(maxpointspec_act.gt.1)) then
570	ncret = nf_def_var(ncid,'MIXINGRATIO',NF_REAL,7,ncdimsid32,ncravid)
571	else
572	ncret = nf_def_var(ncid,'MIXINGRATIO',NF_REAL,6,ncdimsid3,ncravid)
573	endif
574	ncret = NF_DEF_VAR_deflate(ncid,ncravid, shuffle, 1, deflate_level)
575	call check_ncerror(ncret)
576	ncret = nf_put_att_text(ncid,ncravid,descr,37, &
577	'MASS MIXING RATIO OF AIRBORNE SPECIES')
578	call check_ncerror(ncret)
579	ncret = nf_put_att_text(ncid,ncravid,coord,coordxylen,coordxy)
580	call check_ncerror(ncret)
581	endif
582
583	if (ldirect.eq.1) then ! Forward run
584	unit2d = 'pg m-2'
585	unit2dlen = 6
586
587	if (option_verbose.ge.10) write(*,10) 'DRYDEP variable'
588	! write(,) ncdimsid2
589	if ((ldirect.eq.1).and.(maxpointspec_act.gt.1)) then
590	ncret = nf_def_var(ncid,'DRYDEP',NF_REAL,6,ncdimsid22,ncddvid)
591	else
592	ncret = nf_def_var(ncid,'DRYDEP',NF_REAL,5,ncdimsid2,ncddvid)
593	endif
594	ncret = NF_DEF_VAR_deflate(ncid,ncddvid, shuffle, 1, deflate_level)
595	call check_ncerror(ncret)
596	ncret = nf_put_att_text(ncid,ncddvid,descr,32, &
597	'ACCUMULATED TOTAL DRY DEPOSITION')
598	call check_ncerror(ncret)
599	ncret = nf_put_att_text(ncid,ncddvid,units,unit2dlen,unit2d)
600	call check_ncerror(ncret)
601	ncret = nf_put_att_text(ncid,ncddvid,coord,coordxylen,coordxy)
602	call check_ncerror(ncret)
603
604	if (option_verbose.ge.10) write(*,10) 'WETDEP variable'
605	if ((ldirect.eq.1).and.(maxpointspec_act.gt.1)) then
606	ncret = nf_def_var(ncid,'WETDEP',NF_REAL,6,ncdimsid22,ncwdvid)
607	else
608	ncret = nf_def_var(ncid,'WETDEP',NF_REAL,5,ncdimsid2,ncwdvid)
609	endif
610	ncret = NF_DEF_VAR_deflate(ncid,ncwdvid, shuffle, 1, deflate_level)
611	call check_ncerror(ncret)
612	ncret = nf_put_att_text(ncid,ncwdvid,descr,32, &
613	'ACCUMULATED TOTAL WET DEPOSITION')
614	! call check_ncerror(ncret)
615	ncret = nf_put_att_text(ncid,ncwdvid,units,unit2dlen,unit2d)
616	call check_ncerror(ncret)
617	ncret = nf_put_att_text(ncid,ncwdvid,coord,coordxylen,coordxy)
618	call check_ncerror(ncret)
619
620	! Add unit attr to mixing ratio and concentration fields
621	if (ind_samp.eq.0) then
622	ncret = nf_put_att_text(ncid,nccovid,units,6,'ng m-3') !CONC
623	call check_ncerror(ncret)
624	ncret = nf_put_att_text(ncid,ncravid,units,4,'ppt') !MIX
625	call check_ncerror(ncret)
626	else
627	ncret = nf_put_att_text(ncid,nccovid,units,11,'ppt by mass') !CONC
628	call check_ncerror(ncret)
629	! ncret = nf_put_att_text(ncid,ncravid,units,3,'???') !MIX
630	! call check_ncerror(ncret)
631	endif
632	else ! Backward run
633	! if ((ind_rel.eq.0).and.(ind_samp.eq.0) then ! release in mass
634	! write(,) 'A'
635	!Concentration field should be in 's' (?)
636	if ((ind_rel.eq.0).and.(ind_samp.eq.0)) ncret = nf_put_att_text(ncid,nccovid,units,1,'s') !CONC
637	if ((ind_rel.eq.0).and.(ind_samp.eq.-1)) ncret = nf_put_att_text(ncid,nccovid,units,9,'s m3 kg-1') !CONC
638	if ((ind_rel.eq.1).and.(ind_samp.eq.0)) ncret = nf_put_att_text(ncid,nccovid,units,8,'s kg m-3') !CONC
639	if ((ind_rel.eq.1).and.(ind_samp.eq.-1)) ncret = nf_put_att_text(ncid,nccovid,units,1,'s') !CONC
640	!call check_ncerror(ncret)
641	!Mixing ratio field should be in 's kg m-3' (?)
642	!ncret = nf_put_att_text(ncid,ncravid,units,8,'s kg m-3') !RATIO
643	!call check_ncerror(ncret)
644	! else ! release in mass mix
645	!Concentration should be in 's m3 kg-1' (?)
646	! write(,) 'B'
647	! ncret = nf_put_att_text(ncid,nccovid,units,9,'s m3 kg-1') !CONC
648	!call check_ncerror(ncret)
649	!Mixing ratio should be in 's' (?)
650	!ncret = nf_put_att_text(ncid,ncravid,units,1,'s') !RATIO
651	!call check_ncerror(ncret)
652	! endif
653	endif ! Backward/Forward run
654
655	! EXIT DEFINE MODE, ENTER DATA MODE
656	ncret = nf_enddef(ncid)
657	call check_ncerror(ncret)
658
659	! DIMENSION VARIABLES
660	! if (option_verbose.ge.10) write(*,10) 'ZTOP data'
661	! ncret = nf_put_var_real(ncid,nclvlvid,outheight)
662	! call check_ncerror(ncret)
663
664	! ! X,Y - Lon,Lat
665	! if (option_verbose.ge.10) write(*,10) 'XLAT,XLONG data'
666	!
667	! if (outgrid_option.eq.0) then ! irregular
668	! do jy=1,ncgrid_ny
669	! do ix=1,ncgrid_nx
670	! tmpx=ncgrid_xm0+(float(ix)-0.5)*ncgrid_dx
671	! tmpy=ncgrid_ym0+(float(jy)-0.5)*ncgrid_dy
672	! call xymeter_to_ll_wrf(tmpx,tmpy,tmplon,tmplat)
673	! ncret = nf_put_vara_real(ncid,nclonvid,(/ix,jy/),(/1,1/),tmplon)
674	! call check_ncerror(ncret)
675	! ncret = nf_put_vara_real(ncid,nclatvid,(/ix,jy/),(/1,1/),tmplat)
676	! call check_ncerror(ncret)
677	! enddo
678	! enddo
679	! else
680	! do jy=1,ncgrid_ny
681	! do ix=1,ncgrid_nx
682	! call ll_to_xymeter_wrf(ncgrid_swlon,ncgrid_swlat,xsw,ysw)
683	! call ll_to_xymeter_wrf(ncgrid_nelon,ncgrid_nelat,xne,yne)
684	! tmpx=xsw+(xne-xsw)*float(ix-1)/float(ncgrid_nx-1)
685	! tmpy=ysw+(yne-ysw)*float(jy-1)/float(ncgrid_ny-1)
686	! call xymeter_to_ll_wrf(tmpx,tmpy,tmplon,tmplat)
687	! xl2=ncgrid_lon0+(float(ix)-0.5)*dxoutl !long
688	! yl2=ncgrid_lat0+(float(jy)-0.5)*dyoutl !lat
689	! ncret = nf_put_vara_real(ncid,nclonvid,(/ix,jy/),(/1,1/),xl2)
690	! call check_ncerror(ncret)
691	! ncret = nf_put_vara_real(ncid,nclatvid,(/ix,jy/),(/1,1/),yl2)
692	! call check_ncerror(ncret)
693	! enddo
694	! enddo
695	! endif ! outgrid_option
696
697
698	! ! Write information on release points: total number, then for each point:
699	! ! start, end, coordinates, # of particles, name, mass
700	! !************************************************************************
701	! do i=1,numpoint
702	! xp1=xpoint1(i)*dx+xlon0 ! This is probably wrong, but it seems to be
703	! yp1=ypoint1(i)dy+ylat0 ! the same in writeheader.f90, so I'll leave
704	! xp2=xpoint2(i)*dx+xlon0 ! it for now... //AD
705	! yp2=ypoint2(i)*dy+ylat0 !
706	!
707	! if (option_verbose.ge.10) write(*,10) 'ReleaseTstart_end data'
708	! ncret = nf_put_vara_int(ncid,ncrtvid, & ! ReleaseTstart_end
709	! (/1,i/),(/2,1/),(/ireleasestart(i),ireleaseend(i)/))
710	! call check_ncerror(ncret)
711	!
712	! if (option_verbose.ge.10) write(*,10) 'ReleaseXstart_end data'
713	! ncret = nf_put_vara_real(ncid,ncrxvid, & ! ReleaseXstart_end
714	! (/1,i/),(/2,1/),(/xp1,xp2/))
715	! call check_ncerror(ncret)
716	!
717	! if (option_verbose.ge.10) write(*,10) 'ReleaseYstart_end data'
718	! ncret = nf_put_vara_real(ncid,ncryvid, & !ReleaseYstart_end
719	! (/1,i/),(/2,1/),(/yp1,yp2/))
720	! call check_ncerror(ncret)
721	!
722	! if (option_verbose.ge.10) write(*,10) 'ReleaseZstart_end data'
723	! ncret = nf_put_vara_real(ncid,ncrzvid, & !ReleaseZstart_end
724	! (/1,i/),(/2,1/),(/zpoint1(i),zpoint2(i)/))
725	! call check_ncerror(ncret)
726	!
727	! if (option_verbose.ge.10) write(*,10) 'ReleaseXMass data'
728	! ncret = nf_put_vara_real(ncid,ncrmvid, & !ReleaseXMass
729	! (/1,i/),(/nspec,1/),xmass(i,1:nspec))
730	! call check_ncerror(ncret)
731	!
732	! if (option_verbose.ge.10) write(*,10) 'ReleaseNP data'
733	! ncret = nf_put_vara_int(ncid,ncspvid, & !ReleaseNP
734	! i,1,npart(i))
735	! call check_ncerror(ncret)
736	!
737	! !Release Name/Comment
738	! j=1 ! Find the length of each release point comment/name
739	! do while( j.lt.45.and.compoint(i)(j+1:j+1).ne." ")
740	! j=j+1
741	! enddo
742	! if (option_verbose.ge.10) write(*,10) 'ReleaseName data'
743	! ncret = nf_put_vara_text(ncid,ncrnvid,(/1,i/),(/j,1/),compoint(i)(1:j))
744	! call check_ncerror(ncret)
745	! enddo
746	!
747	! ! Write age class information
748	! !****************************
749	! if (option_verbose.ge.10) write(*,10) 'AGECLASSES data'
750	! ncret = nf_put_var_int(ncid,ncagevid,lage(1:nageclass))
751	! call check_ncerror(ncret)
752	!
753	! ! Write topography to output file
754	! !********************************
755	! if (option_verbose.ge.10) write(*,10) 'TOPOGRAPHY data'
756	!! do ix=0,ncgrid_nx-1
757	! do ix=1,ncgrid_nx
758	! ncret = nf_put_vara_real(ncid,nctovid, &
759	!! (/ix+1,1/),(/1,ncgrid_ny/),ncgrid_oro(ix,0:ncgrid_ny-1))
760	! (/ix,1/),(/1,ncgrid_ny/),ncgrid_oro(ix,1:ncgrid_ny))
761	! call check_ncerror(ncret)
762	! enddo
763	!
764	! ! Write grid cell surface area
765	! !*****************************
766	! if (option_verbose.ge.10) write(*,10) 'GRIDAREA data'
767	!! do ix=0,ncgrid_nx-1
768	! do ix=1,ncgrid_nx
769	! ncret = nf_put_vara_real(ncid,ncarvid, &
770	!! (/ix+1,1/),(/1,ncgrid_ny/),ncgrid_area(ix,0:ncgrid_ny-1))
771	! (/ix,1/),(/1,ncgrid_ny/),ncgrid_area(ix,1:ncgrid_ny))
772	! call check_ncerror(ncret)
773	! enddo
774	!
775	! ! SAVE CREATED NETCDF TO FILE
776	! !****************************
777	! if (option_verbose.ge.1) write(,) 'write_ncheader: writing to disk'
778	! ncret = nf_sync(ncid)
779	! call check_ncerror(ncret)
780
781	return
782
783	10 format('write_ncheader: Setting up ',A)
784
785	! deallocate(ncgrid_oro,ncgrid_area)
786	end subroutine write_ncinfo

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

Download in other formats:

Original Format