Context navigation

Back to Ticket #431

Ticket #431: ropp_io_write_ncdf_put.f90.18062015

File ropp_io_write_ncdf_put.f90.18062015, 45.2 KB (added by Ian Culverwell, 9 years ago)
ropp_io_write_ncdf_put.f90.18062015

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

Download in other formats:

Original format