Context navigation

Back to Ticket #431

Ticket #431: ropp_io_write_ncdf_put.f90.17062015

File ropp_io_write_ncdf_put.f90.17062015, 45.1 KB (added by Ian Culverwell, 9 years ago)
ropp_io_write_ncdf_put.f90.17062015

Line
1	! $Id: ropp_io_write_ncdf_put.f90 4452 2015-01-29 14:42:02Z idculv $
2
3	!***is Writing/ropp_io_write_ncdf_put *
4	!
5	! NAME
6	! ropp_io_write_ncdf_put - Put data into a (already defined) netCDF.
7	!
8	! SYNOPSIS
9	! call ropp_io_write_ncdf_putvar(data, rec)
10	!
11	! DESCRIPTION
12	! This subroutine writes data contained in a derived type structure into
13	! a netCDF data file. Variables in this data file must have been created
14	! before by a call to ropp_io_write_ncdf_def.
15	!
16	! INPUTS
17	! data - ROPP derived type
18	! rec - file record number (1-)
19	!
20	! OUTPUT
21	!
22	!
23	! NOTES
24	! A netCDF file must have been created or opened (in an append mode)
25	! using the ncdf_create() or ncdf_open(); this subroutine only works
26	! on the current netcdf file.
27	!
28	! SEE ALSO
29	! ropp_io_write_ncdf
30	! ropp_io_write_ncdf_def
31	! ropp_io_read_ncdf
32	! ropp_io_read_ncdf_get
33	!
34	! CALLS
35	! ncdf_putvar
36	! TimeSince
37	!
38	! REFERENCES
39	!
40	!
41	! AUTHOR
42	! Met Office, Exeter, UK.
43	! Any comments on this software should be given via the ROM SAF
44	! Helpdesk at http://www.romsaf.org
45	!
46	! COPYRIGHT
47	! (c) EUMETSAT. All rights reserved.
48	! For further details please refer to the file COPYRIGHT
49	! which you should have received as part of this distribution.
50	!
51	!****
52
53	!-------------------------------------------------------------------------------
54	! 1. Core RO data
55	!-------------------------------------------------------------------------------
56
57	SUBROUTINE ropp_io_write_put_rodata(DATA, rec)
58
59	! 1.1 Declarations
60	! ----------------
61
62	USE typesizes, ONLY: wp => EightByteReal
63	USE ropp_utils
64	USE ncdf
65	USE ropp_io, not_this => ropp_io_write_put_rodata
66	USE ropp_io_types, ONLY: ROprof
67	USE DateTimeProgs, ONLY: TimeSince
68
69	IMPLICIT NONE
70
71	TYPE(ROprof), INTENT(in) :: DATA
72	INTEGER, OPTIONAL :: rec
73
74	REAL(wp) :: time ! Time in seconds since 00:00 1-Jan-2000
75	INTEGER, DIMENSION(8) :: DT8 ! Date/time array
76	INTEGER :: irec
77	CHARACTER(len = 256) :: routine
78
79	! 1.2 Error handling
80	! ------------------
81
82	CALL message_get_routine(routine)
83	CALL message_set_routine('ropp_io_write_ncdf_put')
84
85	! 1.3 Default parameters
86	! ----------------------
87
88	IF (PRESENT(rec)) THEN
89	irec = rec
90	ELSE
91	irec = 1
92	ENDIF
93
94	! 1.4 Header variables
95	! --------------------
96
97	CALL ncdf_putvar('occ_id', data%occ_id, rec = irec)
98	CALL ncdf_putvar('gns_id', data%gns_id, rec = irec)
99	CALL ncdf_putvar('leo_id', data%leo_id, rec = irec)
100	CALL ncdf_putvar('stn_id', data%stn_id, rec = irec)
101
102	! 1.5 Date and time
103	! -----------------
104
105	! 1.5.1 Derived time for start of occultation
106
107	IF (isroppinrange(data%dtocc)) THEN
108	DT8 = (/data%dtocc%year,data%dtocc%month, data%dtocc%day,0, &
109	data%dtocc%hour,data%dtocc%minute,data%dtocc%second, &
110	data%dtocc%msec/)
111	CALL TimeSince ( DT8, time, 1, Base="JS2000" )
112	ELSE
113	time = 0.0_wp
114	ENDIF
115	CALL ncdf_putvar('start_time', time, rec = irec)
116
117	! 1.5.2 Elements of the data structure
118
119	CALL ncdf_putvar('year', data%dtocc%year, &
120	units = data%dtocc%units%year, &
121	rec = irec)
122	CALL ncdf_putvar('month', data%dtocc%month, &
123	units = data%dtocc%units%month, &
124	rec = irec)
125	CALL ncdf_putvar('day', data%dtocc%day, &
126	units = data%dtocc%units%day, &
127	rec = irec)
128	CALL ncdf_putvar('hour', data%dtocc%hour, &
129	units = data%dtocc%units%hour, &
130	rec = irec)
131	CALL ncdf_putvar('minute', data%dtocc%minute, &
132	units = data%dtocc%units%minute, &
133	rec = irec)
134	CALL ncdf_putvar('second', data%dtocc%second, &
135	units = data%dtocc%units%second, &
136	rec = irec)
137	CALL ncdf_putvar('msec', data%dtocc%msec, &
138	units = data%dtocc%units%msec, &
139	rec = irec)
140
141	! 1.6 Overall quality
142	! -------------------
143
144	CALL ncdf_putvar('pcd', data%pcd, &
145	units = data%units%pcd, &
146	rec = irec)
147	CALL ncdf_putvar('overall_qual', data%overall_qual, &
148	units = data%units%overall_qual, &
149	rec = irec)
150
151	! 1.7 Georeferencing
152	! ------------------
153
154	! 1.7.1 Derived time for nominal time of georef
155
156	CALL ncdf_putvar('time', time+data%georef%time_offset, rec = irec)
157
158	! 1.7.2 Elements of the data structure
159
160	CALL ncdf_putvar('time_offset', data%georef%time_offset, &
161	units = data%georef%units%time_offset, &
162	rec = irec)
163	CALL ncdf_putvar('lat', data%georef%lat, &
164	units = data%georef%units%lat, &
165	rec = irec)
166	CALL ncdf_putvar('lon', data%georef%lon, &
167	units = data%georef%units%lon, &
168	rec = irec)
169	CALL ncdf_putvar('undulation', data%georef%undulation, &
170	units = data%georef%units%undulation, &
171	rec = irec)
172	CALL ncdf_putvar('roc', data%georef%roc, &
173	units = data%georef%units%roc, &
174	rec = irec)
175	CALL ncdf_putvar('r_coc', data%georef%r_coc, &
176	units = data%georef%units%r_coc, &
177	rec = irec)
178	CALL ncdf_putvar('azimuth', data%georef%azimuth, &
179	units = data%georef%units%azimuth, &
180	rec = irec)
181
182	! 1.8 Background characterisation (if any)
183	! ----------------------------------------
184
185	IF (data%BG%Source /= 'NONE') THEN
186	CALL ncdf_putvar('bg_source', data%BG%Source, &
187	rec = irec)
188	CALL ncdf_putvar('bg_year', data%BG%Year, &
189	units = data%BG%units%Year, &
190	rec = irec)
191	CALL ncdf_putvar('bg_month', data%BG%Month, &
192	units = data%BG%units%Month, &
193	rec = irec)
194	CALL ncdf_putvar('bg_day', data%BG%Day, &
195	units = data%BG%units%Day, &
196	rec = irec)
197	CALL ncdf_putvar('bg_hour', data%BG%Hour, &
198	units = data%BG%units%Hour, &
199	rec = irec)
200	CALL ncdf_putvar('bg_minute', data%BG%Minute, &
201	units = data%BG%units%Minute, &
202	rec = irec)
203	CALL ncdf_putvar('bg_fcperiod', data%BG%fcPeriod, &
204	units = data%BG%units%fcPeriod, &
205	rec = irec)
206	ENDIF
207
208	! 1.9 Level 1a variables (if any)
209	! -------------------------------
210
211	IF (data%Lev1a%Npoints > 0) THEN
212
213	CALL ncdf_putvar('dtime', data%Lev1a%dtime, &
214	units = data%Lev1a%units%dtime, &
215	rec = irec)
216	CALL ncdf_putvar('snr_L1ca', data%Lev1a%snr_L1ca, &
217	units = data%Lev1a%units%snr, &
218	rec = irec)
219	CALL ncdf_putvar('snr_L1p', data%Lev1a%snr_L1p, &
220	units = data%Lev1a%units%snr, &
221	rec = irec)
222	CALL ncdf_putvar('snr_L2p', data%Lev1a%snr_L2p, &
223	units = data%Lev1a%units%snr, &
224	rec = irec)
225	CALL ncdf_putvar('phase_L1', data%Lev1a%phase_L1, &
226	units = data%Lev1a%units%phase, &
227	rec = irec)
228	CALL ncdf_putvar('phase_L2', data%Lev1a%phase_L2, &
229	units = data%Lev1a%units%phase, &
230	rec = irec)
231	CALL ncdf_putvar('r_gns', data%Lev1a%r_gns(1:data%Lev1a%Npoints,:), &
232	units = data%Lev1a%units%r_gns, &
233	rec = irec)
234	CALL ncdf_putvar('v_gns', data%Lev1a%v_gns(1:data%Lev1a%Npoints,:), &
235	units = data%Lev1a%units%v_gns, &
236	rec = irec)
237	CALL ncdf_putvar('r_leo', data%Lev1a%r_leo(1:data%Lev1a%Npoints,:), &
238	units = data%Lev1a%units%r_leo, &
239	rec = irec)
240	CALL ncdf_putvar('v_leo', data%Lev1a%v_leo(1:data%Lev1a%Npoints,:), &
241	units = data%Lev1a%units%v_leo, &
242	rec = irec)
243	CALL ncdf_putvar('phase_qual', data%Lev1a%phase_qual, &
244	units = data%Lev1a%units%phase_qual, &
245	rec = irec)
246	ENDIF
247
248	! 1.10 Level 1b variables (if any)
249	! --------------------------------
250
251	IF (data%Lev1b%Npoints > 0) THEN
252
253	CALL ncdf_putvar('lat_tp', data%Lev1b%lat_tp, &
254	units = data%Lev1b%units%lat_tp, &
255	rec = irec)
256	CALL ncdf_putvar('lon_tp', data%Lev1b%lon_tp, &
257	units = data%Lev1b%units%lon_tp, &
258	rec = irec)
259	CALL ncdf_putvar('azimuth_tp', data%Lev1b%azimuth_tp, &
260	units = data%Lev1b%units%azimuth_tp, &
261	rec = irec)
262	CALL ncdf_putvar('impact_L1', data%Lev1b%impact_L1, &
263	units = data%Lev1b%units%impact, &
264	rec = irec)
265	CALL ncdf_putvar('impact_L2', data%Lev1b%impact_L2, &
266	units = data%Lev1b%units%impact, &
267	rec = irec)
268	CALL ncdf_putvar('impact', data%Lev1b%impact, &
269	units = data%Lev1b%units%impact, &
270	rec = irec)
271	CALL ncdf_putvar('impact_opt', data%Lev1b%impact_opt, &
272	units = data%Lev1b%units%impact, &
273	rec = irec)
274	CALL ncdf_putvar('bangle_L1', data%Lev1b%bangle_L1, &
275	units = data%Lev1b%units%bangle, &
276	rec = irec)
277	CALL ncdf_putvar('bangle_L2', data%Lev1b%bangle_L2, &
278	units = data%Lev1b%units%bangle, &
279	rec = irec)
280	CALL ncdf_putvar('bangle', data%Lev1b%bangle, &
281	units = data%Lev1b%units%bangle, &
282	rec = irec)
283	CALL ncdf_putvar('bangle_opt', data%Lev1b%bangle_opt, &
284	units = data%Lev1b%units%bangle, &
285	rec = irec)
286	CALL ncdf_putvar('bangle_L1_sigma', data%Lev1b%bangle_L1_sigma, &
287	units = data%Lev1b%units%bangle_sigma, &
288	rec = irec)
289	CALL ncdf_putvar('bangle_L2_sigma', data%Lev1b%bangle_L2_sigma, &
290	units = data%Lev1b%units%bangle_sigma, &
291	rec = irec)
292	CALL ncdf_putvar('bangle_sigma', data%Lev1b%bangle_sigma, &
293	units = data%Lev1b%units%bangle_sigma, &
294	rec = irec)
295	CALL ncdf_putvar('bangle_opt_sigma', data%Lev1b%bangle_opt_sigma, &
296	units = data%Lev1b%units%bangle_sigma, &
297	rec = irec)
298	CALL ncdf_putvar('bangle_L1_qual', data%Lev1b%bangle_L1_qual, &
299	units = data%Lev1b%units%bangle_qual, &
300	rec = irec)
301	CALL ncdf_putvar('bangle_L2_qual', data%Lev1b%bangle_L2_qual, &
302	units = data%Lev1b%units%bangle_qual, &
303	rec = irec)
304	CALL ncdf_putvar('bangle_qual', data%Lev1b%bangle_qual, &
305	units = data%Lev1b%units%bangle_qual, &
306	rec = irec)
307	CALL ncdf_putvar('bangle_opt_qual', data%Lev1b%bangle_opt_qual, &
308	units = data%Lev1b%units%bangle_qual, &
309	rec = irec)
310	ENDIF
311
312	! 1.11 Level 2a variables (if any)
313	! --------------------------------
314
315	IF (data%Lev2a%Npoints > 0) THEN
316
317	CALL ncdf_putvar('alt_refrac', data%Lev2a%alt_refrac, &
318	units = data%Lev2a%units%alt_refrac, &
319	rec = irec)
320	CALL ncdf_putvar('geop_refrac', data%Lev2a%geop_refrac, &
321	units = data%Lev2a%units%geop_refrac, &
322	rec = irec)
323	CALL ncdf_putvar('refrac', data%Lev2a%refrac, &
324	units = data%Lev2a%units%refrac, &
325	rec = irec)
326	CALL ncdf_putvar('refrac_sigma', data%Lev2a%refrac_sigma, &
327	units = data%Lev2a%units%refrac_sigma, &
328	rec = irec)
329	CALL ncdf_putvar('refrac_qual', data%Lev2a%refrac_qual, &
330	units = data%Lev2a%units%refrac_qual, &
331	rec = irec)
332	CALL ncdf_putvar('dry_temp', data%Lev2a%dry_temp, &
333	units = data%Lev2a%units%dry_temp, &
334	rec = irec)
335	CALL ncdf_putvar('dry_temp_sigma', data%Lev2a%dry_temp_sigma, &
336	units = data%Lev2a%units%dry_temp_sigma, &
337	rec = irec)
338	CALL ncdf_putvar('dry_temp_qual', data%Lev2a%dry_temp_qual, &
339	units = data%Lev2a%units%dry_temp_qual, &
340	rec = irec)
341	ENDIF
342
343	! 1.12 Level 2b variables (if any)
344	! --------------------------------
345
346	IF (data%Lev2b%Npoints > 0) THEN
347
348	CALL ncdf_putvar('geop', data%Lev2b%geop, &
349	units = data%Lev2b%units%geop, &
350	rec = irec)
351	CALL ncdf_putvar('geop_sigma', data%Lev2b%geop_sigma, &
352	units = data%Lev2b%units%geop_sigma, &
353	rec = irec)
354	CALL ncdf_putvar('press', data%Lev2b%press, &
355	units = data%Lev2b%units%press, &
356	rec = irec)
357	CALL ncdf_putvar('press_sigma', data%Lev2b%press_sigma, &
358	units = data%Lev2b%units%press_sigma, &
359	rec = irec)
360	CALL ncdf_putvar('temp', data%Lev2b%temp, &
361	units = data%Lev2b%units%temp, &
362	rec = irec)
363	CALL ncdf_putvar('temp_sigma', data%Lev2b%temp_sigma, &
364	units = data%Lev2b%units%temp_sigma, &
365	rec = irec)
366	CALL ncdf_putvar('shum', data%Lev2b%shum, &
367	units = data%Lev2b%units%shum, &
368	rec = irec)
369	CALL ncdf_putvar('shum_sigma', data%Lev2b%shum_sigma, &
370	units = data%Lev2b%units%shum_sigma, &
371	rec = irec)
372	CALL ncdf_putvar('meteo_qual', data%Lev2b%meteo_qual, &
373	units = data%Lev2b%units%meteo_qual, &
374	rec = irec)
375	ENDIF
376
377	! 1.13 Level 2c variables (if any)
378	! --------------------------------
379
380	IF (data%Lev2c%Npoints > 0) THEN
381
382	CALL ncdf_putvar('geop_sfc', data%Lev2c%geop_sfc, &
383	units = data%Lev2c%units%geop_sfc, &
384	rec = irec)
385	CALL ncdf_putvar('press_sfc', data%Lev2c%press_sfc, &
386	units = data%Lev2c%units%press_sfc, &
387	rec = irec)
388	CALL ncdf_putvar('press_sfc_sigma', data%Lev2c%press_sfc_sigma, &
389	units = data%Lev2c%units%press_sfc_sigma, &
390	rec = irec)
391	CALL ncdf_putvar('press_sfc_qual', data%Lev2c%press_sfc_qual, &
392	units = data%Lev2c%units%press_sfc_qual, &
393	rec = irec)
394
395	CALL ncdf_putvar('Ne_max', data%Lev2c%Ne_max, &
396	units = data%Lev2c%units%Ne_max, &
397	rec = irec)
398	CALL ncdf_putvar('Ne_max_sigma', data%Lev2c%Ne_max_sigma, &
399	units = data%Lev2c%units%Ne_max_sigma, &
400	rec = irec)
401	CALL ncdf_putvar('H_peak', data%Lev2c%H_peak, &
402	units = data%Lev2c%units%H_peak, &
403	rec = irec)
404	CALL ncdf_putvar('H_peak_sigma', data%Lev2c%H_peak_sigma, &
405	units = data%Lev2c%units%H_peak_sigma, &
406	rec = irec)
407	CALL ncdf_putvar('H_width', data%Lev2c%H_width, &
408	units = data%Lev2c%units%H_width, &
409	rec = irec)
410	CALL ncdf_putvar('H_width_sigma', data%Lev2c%H_width_sigma, &
411	units = data%Lev2c%units%H_width_sigma, &
412	rec = irec)
413
414	CALL ncdf_putvar('tph_bangle', data%Lev2c%tph_bangle, &
415	units = data%Lev2c%units%tph_bangle, &
416	rec = irec)
417	CALL ncdf_putvar('tpa_bangle', data%Lev2c%tpa_bangle, &
418	units = data%Lev2c%units%tpa_bangle, &
419	rec = irec)
420	CALL ncdf_putvar('tph_bangle_flag', data%Lev2c%tph_bangle_flag, &
421	units = data%Lev2c%units%tph_bangle_flag, &
422	rec = irec)
423
424	CALL ncdf_putvar('tph_refrac', data%Lev2c%tph_refrac, &
425	units = data%Lev2c%units%tph_refrac, &
426	rec = irec)
427	CALL ncdf_putvar('tpn_refrac', data%Lev2c%tpn_refrac, &
428	units = data%Lev2c%units%tpn_refrac, &
429	rec = irec)
430	CALL ncdf_putvar('tph_refrac_flag', data%Lev2c%tph_refrac_flag, &
431	units = data%Lev2c%units%tph_refrac_flag, &
432	rec = irec)
433
434	CALL ncdf_putvar('tph_tdry_lrt', data%Lev2c%tph_tdry_lrt, &
435	units = data%Lev2c%units%tph_tdry_lrt, &
436	rec = irec)
437	CALL ncdf_putvar('tpt_tdry_lrt', data%Lev2c%tpt_tdry_lrt, &
438	units = data%Lev2c%units%tpt_tdry_lrt, &
439	rec = irec)
440	CALL ncdf_putvar('tph_tdry_lrt_flag', data%Lev2c%tph_tdry_lrt_flag, &
441	units = data%Lev2c%units%tph_tdry_lrt_flag, &
442	rec = irec)
443
444	CALL ncdf_putvar('tph_tdry_cpt', data%Lev2c%tph_tdry_cpt, &
445	units = data%Lev2c%units%tph_tdry_cpt, &
446	rec = irec)
447	CALL ncdf_putvar('tpt_tdry_cpt', data%Lev2c%tpt_tdry_cpt, &
448	units = data%Lev2c%units%tpt_tdry_cpt, &
449	rec = irec)
450	CALL ncdf_putvar('tph_tdry_cpt_flag', data%Lev2c%tph_tdry_cpt_flag, &
451	units = data%Lev2c%units%tph_tdry_cpt_flag, &
452	rec = irec)
453
454	CALL ncdf_putvar('prh_tdry_cpt', data%Lev2c%prh_tdry_cpt, &
455	units = data%Lev2c%units%prh_tdry_cpt, &
456	rec = irec)
457	CALL ncdf_putvar('prt_tdry_cpt', data%Lev2c%prt_tdry_cpt, &
458	units = data%Lev2c%units%prt_tdry_cpt, &
459	rec = irec)
460	CALL ncdf_putvar('prh_tdry_cpt_flag', data%Lev2c%prh_tdry_cpt_flag, &
461	units = data%Lev2c%units%prh_tdry_cpt_flag, &
462	rec = irec)
463
464	CALL ncdf_putvar('tph_temp_lrt', data%Lev2c%tph_temp_lrt, &
465	units = data%Lev2c%units%tph_temp_lrt, &
466	rec = irec)
467	CALL ncdf_putvar('tpt_temp_lrt', data%Lev2c%tpt_temp_lrt, &
468	units = data%Lev2c%units%tpt_temp_lrt, &
469	rec = irec)
470	CALL ncdf_putvar('tph_temp_lrt_flag', data%Lev2c%tph_temp_lrt_flag, &
471	units = data%Lev2c%units%tph_temp_lrt_flag, &
472	rec = irec)
473
474	CALL ncdf_putvar('tph_temp_cpt', data%Lev2c%tph_temp_cpt, &
475	units = data%Lev2c%units%tph_temp_cpt, &
476	rec = irec)
477	CALL ncdf_putvar('tpt_temp_cpt', data%Lev2c%tpt_temp_cpt, &
478	units = data%Lev2c%units%tpt_temp_cpt, &
479	rec = irec)
480	CALL ncdf_putvar('tph_temp_cpt_flag', data%Lev2c%tph_temp_cpt_flag, &
481	units = data%Lev2c%units%tph_temp_cpt_flag, &
482	rec = irec)
483
484	CALL ncdf_putvar('prh_temp_cpt', data%Lev2c%prh_temp_cpt, &
485	units = data%Lev2c%units%prh_temp_cpt, &
486	rec = irec)
487	CALL ncdf_putvar('prt_temp_cpt', data%Lev2c%prt_temp_cpt, &
488	units = data%Lev2c%units%prt_temp_cpt, &
489	rec = irec)
490	CALL ncdf_putvar('prh_temp_cpt_flag', data%Lev2c%prh_temp_cpt_flag, &
491	units = data%Lev2c%units%prh_temp_cpt_flag, &
492	rec = irec)
493
494	ENDIF
495
496	! 1.14 Level 2d variables (if any)
497	! --------------------------------
498
499	IF (data%Lev2d%Npoints > 0) THEN
500
501	CALL ncdf_putvar('level_type', data%Lev2d%level_type, &
502	rec = irec)
503	CALL ncdf_putvar('level_coeff_a', data%Lev2d%level_coeff_a, &
504	units = data%Lev2d%units%level_coeff_a, &
505	rec = irec)
506	CALL ncdf_putvar('level_coeff_b', data%Lev2d%level_coeff_b, &
507	units = data%Lev2d%units%level_coeff_b, &
508	rec = irec)
509	ENDIF
510
511	! 1.15 Additional variables (if any)
512	! ----------------------------------
513
514	IF (SIZE(data%vlist%VlistD0d) > 0) THEN
515	CALL ropp_io_write_put_vlistD0d(data%vlist%VlistD0d, rec = irec)
516	ENDIF
517
518	IF (SIZE(data%vlist%VlistD1d) > 0) THEN
519	CALL ropp_io_write_put_vlistD1d(data%vlist%VlistD1d, rec = irec)
520	ENDIF
521
522	IF (SIZE(data%vlist%VlistD2d) > 0) THEN
523	CALL ropp_io_write_put_vlistD2d(data%vlist%VlistD2d, rec = irec)
524	ENDIF
525
526	! 1.16 Clean up
527	! -------------
528
529	CALL message_set_routine(routine)
530
531	END SUBROUTINE ropp_io_write_put_rodata
532
533	!-------------------------------------------------------------------------------
534	! 2. Core RO data (two-dimensional meteorological data)
535	!-------------------------------------------------------------------------------
536
537	SUBROUTINE ropp_io_write_put_rodata_2d(DATA, rec)
538
539	! 2.1 Declarations
540	! ----------------
541
542	USE typesizes, ONLY: wp => EightByteReal
543	USE ropp_utils
544	USE ncdf
545	USE ropp_io, not_this => ropp_io_write_put_rodata_2d
546	USE ropp_io_types, ONLY: ROprof2d
547	USE DateTimeProgs, ONLY: TimeSince
548
549	IMPLICIT NONE
550
551	TYPE(ROprof2d), INTENT(in) :: DATA
552	INTEGER, OPTIONAL :: rec
553
554	REAL(wp) :: time
555	INTEGER, DIMENSION(8) :: DT8
556
557	INTEGER :: irec
558
559	CHARACTER(len = 256) :: routine
560
561	! 2.2 Error handling
562	! ------------------
563
564	CALL message_get_routine(routine)
565	CALL message_set_routine('ropp_io_write_ncdf_put')
566
567	! 2.3 Default parameters
568	! ----------------------
569
570	IF (PRESENT(rec)) THEN
571	irec = rec
572	ELSE
573	irec = 1
574	ENDIF
575
576	! 2.4 Header variables
577	! --------------------
578
579	CALL ncdf_putvar('occ_id', data%occ_id, rec = irec)
580	CALL ncdf_putvar('gns_id', data%gns_id, rec = irec)
581	CALL ncdf_putvar('leo_id', data%leo_id, rec = irec)
582	CALL ncdf_putvar('stn_id', data%stn_id, rec = irec)
583
584	! 2.5 Date and time
585	! -----------------
586
587	! 2.5.1 Derived time for start of occultation
588
589	IF (isroppinrange(data%dtocc)) THEN
590	DT8 = (/data%dtocc%year,data%dtocc%month, data%dtocc%day,0, &
591	data%dtocc%hour,data%dtocc%minute,data%dtocc%second, &
592	data%dtocc%msec/)
593	CALL TimeSince ( DT8, time, 1, Base="JS2000" )
594	ELSE
595	time = 0.0_wp
596	ENDIF
597	CALL ncdf_putvar('start_time', time, rec = irec)
598
599	! 2.5.2 Elements of the data structure
600
601	CALL ncdf_putvar('year', data%dtocc%year, &
602	units = data%dtocc%units%year, &
603	rec = irec)
604	CALL ncdf_putvar('month', data%dtocc%month, &
605	units = data%dtocc%units%month, &
606	rec = irec)
607	CALL ncdf_putvar('day', data%dtocc%day, &
608	units = data%dtocc%units%day, &
609	rec = irec)
610	CALL ncdf_putvar('hour', data%dtocc%hour, &
611	units = data%dtocc%units%hour, &
612	rec = irec)
613	CALL ncdf_putvar('minute', data%dtocc%minute, &
614	units = data%dtocc%units%minute, &
615	rec = irec)
616	CALL ncdf_putvar('second', data%dtocc%second, &
617	units = data%dtocc%units%second, &
618	rec = irec)
619	CALL ncdf_putvar('msec', data%dtocc%msec, &
620	units = data%dtocc%units%msec, &
621	rec = irec)
622
623	! 2.6 Overall quality
624	! -------------------
625
626	CALL ncdf_putvar('pcd', data%pcd, &
627	units = data%units%pcd, &
628	rec = irec)
629	CALL ncdf_putvar('overall_qual', data%overall_qual, &
630	units = data%units%overall_qual, &
631	rec = irec)
632
633	! 2.7 Georeferencing
634	! ------------------
635
636	! 2.7.1 Derived time for nominal time of georef
637
638	CALL ncdf_putvar('time', time, rec = irec)
639
640	! 2.7.2 Elements of the data structure
641
642	CALL ncdf_putvar('time_offset', data%georef%time_offset, &
643	units = data%georef%units%time_offset, &
644	rec = irec)
645	CALL ncdf_putvar('lat', data%georef%lat, &
646	units = data%georef%units%lat, &
647	rec = irec)
648	CALL ncdf_putvar('lon', data%georef%lon, &
649	units = data%georef%units%lon, &
650	rec = irec)
651	CALL ncdf_putvar('undulation', data%georef%undulation, &
652	units = data%georef%units%undulation, &
653	rec = irec)
654	CALL ncdf_putvar('roc', data%georef%roc, &
655	units = data%georef%units%roc, &
656	rec = irec)
657	CALL ncdf_putvar('r_coc', data%georef%r_coc, &
658	units = data%georef%units%r_coc, &
659	rec = irec)
660	CALL ncdf_putvar('azimuth', data%georef%azimuth, &
661	units = data%georef%units%azimuth, &
662	rec = irec)
663
664	! 2.8 Background characterisation (if any)
665	! ----------------------------------------
666
667	IF (data%BG%Source /= 'NONE') THEN
668	CALL ncdf_putvar('bg_source', data%BG%Source, &
669	rec = irec)
670	CALL ncdf_putvar('bg_year', data%BG%Year, &
671	units = data%BG%units%Year, &
672	rec = irec)
673	CALL ncdf_putvar('bg_month', data%BG%Month, &
674	units = data%BG%units%Month, &
675	rec = irec)
676	CALL ncdf_putvar('bg_day', data%BG%Day, &
677	units = data%BG%units%Day, &
678	rec = irec)
679	CALL ncdf_putvar('bg_hour', data%BG%Hour, &
680	units = data%BG%units%Hour, &
681	rec = irec)
682	CALL ncdf_putvar('bg_minute', data%BG%Minute, &
683	units = data%BG%units%Minute, &
684	rec = irec)
685	CALL ncdf_putvar('bg_fcperiod', data%BG%fcPeriod, &
686	units = data%BG%units%fcPeriod, &
687	rec = irec)
688	ENDIF
689
690	! 2.9 Level 1a variables (if any)
691	! -------------------------------
692
693	IF (data%Lev1a%Npoints > 0) THEN
694
695	CALL ncdf_putvar('dtime', data%Lev1a%dtime, &
696	units = data%Lev1a%units%dtime, &
697	rec = irec)
698	CALL ncdf_putvar('snr_L1ca', data%Lev1a%snr_L1ca, &
699	units = data%Lev1a%units%snr, &
700	rec = irec)
701	CALL ncdf_putvar('snr_L1p', data%Lev1a%snr_L1p, &
702	units = data%Lev1a%units%snr, &
703	rec = irec)
704	CALL ncdf_putvar('snr_L2p', data%Lev1a%snr_L2p, &
705	units = data%Lev1a%units%snr, &
706	rec = irec)
707	CALL ncdf_putvar('phase_L1', data%Lev1a%phase_L1, &
708	units = data%Lev1a%units%phase, &
709	rec = irec)
710	CALL ncdf_putvar('phase_L2', data%Lev1a%phase_L2, &
711	units = data%Lev1a%units%phase, &
712	rec = irec)
713	CALL ncdf_putvar('r_gns', data%Lev1a%r_gns(1:data%Lev1a%Npoints,:), &
714	units = data%Lev1a%units%r_gns, &
715	rec = irec)
716	CALL ncdf_putvar('v_gns', data%Lev1a%v_gns(1:data%Lev1a%Npoints,:), &
717	units = data%Lev1a%units%v_gns, &
718	rec = irec)
719	CALL ncdf_putvar('r_leo', data%Lev1a%r_leo(1:data%Lev1a%Npoints,:), &
720	units = data%Lev1a%units%r_leo, &
721	rec = irec)
722	CALL ncdf_putvar('v_leo', data%Lev1a%v_leo(1:data%Lev1a%Npoints,:), &
723	units = data%Lev1a%units%v_leo, &
724	rec = irec)
725	CALL ncdf_putvar('phase_qual', data%Lev1a%phase_qual, &
726	units = data%Lev1a%units%phase_qual, &
727	rec = irec)
728	ENDIF
729
730	! 2.10 Level 1b variables (if any)
731	! --------------------------------
732
733	IF (data%Lev1b%Npoints > 0) THEN
734
735	CALL ncdf_putvar('lat_tp', data%Lev1b%lat_tp, &
736	units = data%Lev1b%units%lat_tp, &
737	rec = irec)
738	CALL ncdf_putvar('lon_tp', data%Lev1b%lon_tp, &
739	units = data%Lev1b%units%lon_tp, &
740	rec = irec)
741	CALL ncdf_putvar('azimuth_tp', data%Lev1b%azimuth_tp, &
742	units = data%Lev1b%units%azimuth_tp, &
743	rec = irec)
744	CALL ncdf_putvar('impact_L1', data%Lev1b%impact_L1, &
745	units = data%Lev1b%units%impact, &
746	rec = irec)
747	CALL ncdf_putvar('impact_L2', data%Lev1b%impact_L2, &
748	units = data%Lev1b%units%impact, &
749	rec = irec)
750	CALL ncdf_putvar('impact', data%Lev1b%impact, &
751	units = data%Lev1b%units%impact, &
752	rec = irec)
753	CALL ncdf_putvar('impact_opt', data%Lev1b%impact_opt, &
754	units = data%Lev1b%units%impact, &
755	rec = irec)
756	CALL ncdf_putvar('bangle_L1', data%Lev1b%bangle_L1, &
757	units = data%Lev1b%units%bangle, &
758	rec = irec)
759	CALL ncdf_putvar('bangle_L2', data%Lev1b%bangle_L2, &
760	units = data%Lev1b%units%bangle, &
761	rec = irec)
762	CALL ncdf_putvar('bangle', data%Lev1b%bangle, &
763	units = data%Lev1b%units%bangle, &
764	rec = irec)
765	CALL ncdf_putvar('bangle_opt', data%Lev1b%bangle_opt, &
766	units = data%Lev1b%units%bangle, &
767	rec = irec)
768	CALL ncdf_putvar('bangle_L1_sigma', data%Lev1b%bangle_L1_sigma, &
769	units = data%Lev1b%units%bangle_sigma, &
770	rec = irec)
771	CALL ncdf_putvar('bangle_L2_sigma', data%Lev1b%bangle_L2_sigma, &
772	units = data%Lev1b%units%bangle_sigma, &
773	rec = irec)
774	CALL ncdf_putvar('bangle_sigma', data%Lev1b%bangle_sigma, &
775	units = data%Lev1b%units%bangle_sigma, &
776	rec = irec)
777	CALL ncdf_putvar('bangle_opt_sigma', data%Lev1b%bangle_opt_sigma, &
778	units = data%Lev1b%units%bangle_sigma, &
779	rec = irec)
780	CALL ncdf_putvar('bangle_L1_qual', data%Lev1b%bangle_L1_qual, &
781	units = data%Lev1b%units%bangle_qual, &
782	rec = irec)
783	CALL ncdf_putvar('bangle_L2_qual', data%Lev1b%bangle_L2_qual, &
784	units = data%Lev1b%units%bangle_qual, &
785	rec = irec)
786	CALL ncdf_putvar('bangle_qual', data%Lev1b%bangle_qual, &
787	units = data%Lev1b%units%bangle_qual, &
788	rec = irec)
789	CALL ncdf_putvar('bangle_opt_qual', data%Lev1b%bangle_opt_qual, &
790	units = data%Lev1b%units%bangle_qual, &
791	rec = irec)
792	ENDIF
793
794	! 2.11 Level 2a variables (if any)
795	! --------------------------------
796
797	IF (data%Lev2a%Npoints > 0) THEN
798
799	CALL ncdf_putvar('alt_refrac', data%Lev2a%alt_refrac, &
800	units = data%Lev2a%units%alt_refrac, &
801	rec = irec)
802	CALL ncdf_putvar('geop_refrac', data%Lev2a%geop_refrac, &
803	units = data%Lev2a%units%geop_refrac, &
804	rec = irec)
805	CALL ncdf_putvar('refrac', data%Lev2a%refrac, &
806	units = data%Lev2a%units%refrac, &
807	rec = irec)
808	CALL ncdf_putvar('refrac_sigma', data%Lev2a%refrac_sigma, &
809	units = data%Lev2a%units%refrac_sigma, &
810	rec = irec)
811	CALL ncdf_putvar('refrac_qual', data%Lev2a%refrac_qual, &
812	units = data%Lev2a%units%refrac_qual, &
813	rec = irec)
814	CALL ncdf_putvar('dry_temp', data%Lev2a%dry_temp, &
815	units = data%Lev2a%units%dry_temp, &
816	rec = irec)
817	CALL ncdf_putvar('dry_temp_sigma', data%Lev2a%dry_temp_sigma, &
818	units = data%Lev2a%units%dry_temp_sigma, &
819	rec = irec)
820	CALL ncdf_putvar('dry_temp_qual', data%Lev2a%dry_temp_qual, &
821	units = data%Lev2a%units%dry_temp_qual, &
822	rec = irec)
823	ENDIF
824
825	! 2.12 Level 2b variables (if any)
826	! --------------------------------
827
828	IF (data%Lev2b%Npoints > 0) THEN
829
830	CALL ncdf_putvar('geop', data%Lev2b%geop, &
831	units = data%Lev2b%units%geop, &
832	rec = irec)
833	CALL ncdf_putvar('geop_sigma', data%Lev2b%geop_sigma, &
834	units = data%Lev2b%units%geop_sigma, &
835	rec = irec)
836	CALL ncdf_putvar('press', data%Lev2b%press, &
837	units = data%Lev2b%units%press, &
838	rec = irec)
839	CALL ncdf_putvar('press_sigma', data%Lev2b%press_sigma, &
840	units = data%Lev2b%units%press_sigma, &
841	rec = irec)
842	CALL ncdf_putvar('temp', data%Lev2b%temp, &
843	units = data%Lev2b%units%temp, &
844	rec = irec)
845	CALL ncdf_putvar('temp_sigma', data%Lev2b%temp_sigma, &
846	units = data%Lev2b%units%temp_sigma, &
847	rec = irec)
848	CALL ncdf_putvar('shum', data%Lev2b%shum, &
849	units = data%Lev2b%units%shum, &
850	rec = irec)
851	CALL ncdf_putvar('shum_sigma', data%Lev2b%shum_sigma, &
852	units = data%Lev2b%units%shum_sigma, &
853	rec = irec)
854	CALL ncdf_putvar('meteo_qual', data%Lev2b%meteo_qual, &
855	units = data%Lev2b%units%meteo_qual, &
856	rec = irec)
857	ENDIF
858
859	! 2.13 Level 2c variables (if any)
860	! --------------------------------
861
862	IF (data%Lev2c%Npoints > 0) THEN
863
864
865	! new 2d variables (sbh)
866
867	CALL ncdf_putvar('dtheta', data%Lev2c%dtheta, &
868	units = data%Lev2c%units%dtheta, &
869	rec = irec)
870	CALL ncdf_putvar('lat_2d', data%Lev2c%lat_2d, &
871	units = data%Lev2c%units%lat_2d, &
872	rec = irec)
873	CALL ncdf_putvar('lon_2d', data%Lev2c%lon_2d, &
874	units = data%Lev2c%units%lon_2d, &
875	rec = irec)
876
877	CALL ncdf_putvar('geop_sfc', data%Lev2c%geop_sfc, &
878	units = data%Lev2c%units%geop_sfc, &
879	rec = irec)
880	CALL ncdf_putvar('press_sfc', data%Lev2c%press_sfc, &
881	units = data%Lev2c%units%press_sfc, &
882	rec = irec)
883	CALL ncdf_putvar('press_sfc_sigma', data%Lev2c%press_sfc_sigma, &
884	units = data%Lev2c%units%press_sfc_sigma, &
885	rec = irec)
886	CALL ncdf_putvar('press_sfc_qual', data%Lev2c%press_sfc_qual, &
887	units = data%Lev2c%units%press_sfc_qual, &
888	rec = irec)
889	ENDIF
890
891	! 2.14 Level 2d variables (if any)
892	! --------------------------------
893
894	IF (data%Lev2d%Npoints > 0) THEN
895
896	CALL ncdf_putvar('level_type', data%Lev2d%level_type, &
897	rec = irec)
898	CALL ncdf_putvar('level_coeff_a', data%Lev2d%level_coeff_a, &
899	units = data%Lev2d%units%level_coeff_a, &
900	rec = irec)
901	CALL ncdf_putvar('level_coeff_b', data%Lev2d%level_coeff_b, &
902	units = data%Lev2d%units%level_coeff_b, &
903	rec = irec)
904	ENDIF
905
906	! 2.15 Additional variables (if any)
907	! ----------------------------------
908
909	IF (SIZE(data%vlist%VlistD0d) > 0) THEN
910	CALL ropp_io_write_put_vlistD0d(data%vlist%VlistD0d, rec = irec)
911	ENDIF
912
913	IF (SIZE(data%vlist%VlistD1d) > 0) THEN
914	CALL ropp_io_write_put_vlistD1d(data%vlist%VlistD1d, rec = irec)
915	ENDIF
916
917	IF (SIZE(data%vlist%VlistD2d) > 0) THEN
918	CALL ropp_io_write_put_vlistD2d(data%vlist%VlistD2d, rec = irec)
919	ENDIF
920
921	! 2.16 Clean up
922	! -------------
923
924	CALL message_set_routine(routine)
925
926	END SUBROUTINE ropp_io_write_put_rodata_2d
927
928	!-------------------------------------------------------------------------------
929	! 3. Vlist for scalar variables
930	!-------------------------------------------------------------------------------
931
932	RECURSIVE SUBROUTINE ropp_io_write_put_vlistD0d(vlist, rec)
933
934	! 3.1 Declarations
935	! ----------------
936
937	USE ropp_utils
938	USE ncdf
939	USE ropp_io, not_this => ropp_io_write_put_vlistD0d
940	USE ropp_io_types, ONLY: VlisttypeD0d
941
942	IMPLICIT NONE
943
944	TYPE(VlisttypeD0d), INTENT(in) :: vlist
945	INTEGER, OPTIONAL :: rec
946
947	INTEGER :: irec
948	CHARACTER(len = 256) :: routine
949
950	! 3.2 Error handling
951	! ------------------
952
953	CALL message_get_routine(routine)
954	CALL message_set_routine('ropp_io_write_ncdf_put')
955
956	! 3.3 Default parameters
957	! ----------------------
958
959	IF (PRESENT(rec)) THEN
960	irec = rec
961	ELSE
962	irec = 1
963	ENDIF
964
965	! 3.4 Header variables
966	! --------------------
967
968	CALL ncdf_putvar(vlist%name, vlist%data, rec = irec)
969
970	! 3.5 Write next variable
971	! -----------------------
972
973	IF (ASSOCIATED(vlist%next)) THEN
974	CALL ropp_io_write_put_vlistD0d(vlist%next, irec)
975	ENDIF
976
977	! 3.6 Clean up
978	! ------------
979
980	CALL message_set_routine(routine)
981
982	END SUBROUTINE ropp_io_write_put_vlistD0d
983
984
985	!-------------------------------------------------------------------------------
986	! 4. Vlist for one dimensional variables
987	!-------------------------------------------------------------------------------
988
989	RECURSIVE SUBROUTINE ropp_io_write_put_vlistD1d(vlist, rec)
990
991	! 4.1 Declarations
992	! ----------------
993
994	USE ropp_utils
995	USE ncdf
996	USE ropp_io, not_this => ropp_io_write_put_vlistD1d
997	USE ropp_io_types, ONLY: VlisttypeD1d
998
999	IMPLICIT NONE
1000
1001	TYPE(VlisttypeD1d), INTENT(in) :: vlist
1002	INTEGER, OPTIONAL :: rec
1003
1004	INTEGER :: irec
1005	CHARACTER(len = 256) :: routine
1006
1007	! 4.2 Error handling
1008	! ------------------
1009
1010	CALL message_get_routine(routine)
1011	CALL message_set_routine('ropp_io_write_ncdf_put')
1012
1013	! 4.3 Default parameters
1014	! ----------------------
1015
1016	IF (PRESENT(rec)) THEN
1017	irec = rec
1018	ELSE
1019	irec = 1
1020	ENDIF
1021
1022	! 4.4 Header variables
1023	! --------------------
1024
1025	CALL ncdf_putvar(vlist%name, vlist%data, rec = irec)
1026
1027	! 4.5 Write next variable
1028	! -----------------------
1029
1030	IF (ASSOCIATED(vlist%next)) THEN
1031	CALL ropp_io_write_put_vlistD1d(vlist%next, irec)
1032	ENDIF
1033
1034	! 4.6 Clean up
1035	! ------------
1036
1037	CALL message_set_routine(routine)
1038
1039	END SUBROUTINE ropp_io_write_put_vlistD1d
1040
1041
1042	!-------------------------------------------------------------------------------
1043	! 5. Vlist for two dimensional variables
1044	!-------------------------------------------------------------------------------
1045
1046	RECURSIVE SUBROUTINE ropp_io_write_put_vlistD2d(vlist, rec)
1047
1048	! 5.1 Declarations
1049	! ----------------
1050
1051	USE ropp_utils
1052	USE ncdf
1053	USE ropp_io, not_this => ropp_io_write_put_vlistD2d
1054	USE ropp_io_types, ONLY: VlisttypeD2d
1055
1056	IMPLICIT NONE
1057
1058	TYPE(VlisttypeD2d), INTENT(in) :: vlist
1059	INTEGER, OPTIONAL :: rec
1060
1061	INTEGER :: irec
1062	CHARACTER(len = 256) :: routine
1063
1064	! 5.2 Error handling
1065	! ------------------
1066
1067	CALL message_get_routine(routine)
1068	CALL message_set_routine('ropp_io_write_ncdf_put')
1069
1070	! 5.3 Default parameters
1071	! ----------------------
1072
1073	IF (PRESENT(rec)) THEN
1074	irec = rec
1075	ELSE
1076	irec = 1
1077	ENDIF
1078
1079	! 5.4 Header variables
1080	! --------------------
1081
1082	CALL ncdf_putvar(vlist%name, vlist%data, rec = irec)
1083
1084	! 5.5 Write next variable
1085	! -----------------------
1086
1087	IF (ASSOCIATED(vlist%next)) THEN
1088	CALL ropp_io_write_put_vlistD2d(vlist%next, irec)
1089	ENDIF
1090
1091	! 5.6 Clean up
1092	! ------------
1093
1094	CALL message_set_routine(routine)
1095
1096	END SUBROUTINE ropp_io_write_put_vlistD2d

Download in other formats:

Original format