Home

Context Navigation

source: palm/trunk/UTIL/combine_virtual_measurements/combine_virtual_measurements.f90 @ 4218

Last change on this file since 4218 was 3928, checked in by gronemeier, 6 years ago
change dimensions in NetCDF output files of virtual measurements; add output path to namelist
Property svn:keywords set to `Id`
File size: 31.6 KB

Line
1	!> @file combine_virtual_measurements.f90
2	!------------------------------------------------------------------------------!
3	! This file is part of the PALM model system.
4	!
5	! PALM is free software: you can redistribute it and/or modify it under the
6	! terms of the GNU General Public License as published by the Free Software
7	! Foundation, either version 3 of the License, or (at your option) any later
8	! version.
9	!
10	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11	! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12	! A PARTICULAR PURPOSE. See the GNU General Public License for more details.
13	!
14	! You should have received a copy of the GNU General Public License along with
15	! PALM. If not, see <http://www.gnu.org/licenses/>.
16	!
17	! Copyright 1997-2018 Leibniz Universitaet Hannover
18	!------------------------------------------------------------------------------!
19	!
20	! Current revisions:
21	! -----------------
22	!
23	!
24	! Former revisions:
25	! -----------------
26	! $Id: combine_virtual_measurements.f90 3928 2019-04-23 20:58:53Z knoop $
27	! rename subroutines
28	! remove space dimensions; add positions dimension
29	! add output path to namelist
30	!
31	! 3705 2019-01-29 19:56:39Z suehring
32	! Initial revsion
33	!
34	! 3704 2019-01-29 19:51:41Z suehring
35	!
36	! Authors:
37	! --------
38	! @author Matthias Suehring
39	!
40	!
41	!------------------------------------------------------------------------------!
42	! Description:
43	! ------------
44	!> This routines merges binary output from virtual measurements taken from
45	!> different subdomains and creates a NetCDF output file according to the (UC)2
46	!> data standard.
47	!------------------------------------------------------------------------------!
48	PROGRAM combine_virtual_measurements
49
50	#if defined( __netcdf )
51	USE NETCDF
52	#endif
53
54	IMPLICIT NONE
55
56	CHARACTER(LEN=34) :: char_in !< dummy string
57	CHARACTER(LEN=4) :: file_suffix = '.bin' !< string which contain the suffix indicating virtual measurement data
58	CHARACTER(LEN=30) :: myid_char !< combined string indicating binary file
59	CHARACTER(LEN=100) :: path_input !< path to the binary input data
60	CHARACTER(LEN=100) :: path_output !< path to the netcdf output files
61	CHARACTER(LEN=100) :: run !< name of the run
62
63	CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: site !< name of the site
64	CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: filename !< name of the original file
65	CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: feature_type !< string indicating the type of the measurement
66	CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: soil_quantity !< string indicating soil measurements
67	CHARACTER(LEN=10), DIMENSION(:,:), ALLOCATABLE :: variables !< list of measured variables
68
69	CHARACTER(LEN=6), DIMENSION(5) :: soil_quantities = (/ & !< list of measurable soil variables
70	"t_soil", &
71	"m_soil", &
72	"lwc ", &
73	"lwcs ", &
74	"smp " /)
75
76	INTEGER, PARAMETER :: iwp = 4 !< integer precision
77	INTEGER, PARAMETER :: wp = 8 !< float precision
78
79	INTEGER(iwp) :: cycle_number !< cycle number
80	INTEGER(iwp) :: f !< running index over all binary files
81	INTEGER(iwp) :: file_id_in = 18 !< file unit for input binaray file
82	INTEGER(iwp) :: l !< running index indicating the actual site
83	INTEGER(iwp) :: n !< running index over all variables measured at a site
84	INTEGER(iwp) :: num_pe !< number of processors used for the run
85	INTEGER(iwp) :: nvm !< number of sites
86	INTEGER(iwp) :: status_nc !< NetCDF error code, return value
87
88	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: ns !< number of observation coordinates on current subdomain
89	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: ns_tot !< total number of observation coordinates for a site
90	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: ns_soil !< number of observation coordinates for soil quantities (on current subdomain)
91	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: ns_soil_tot !< total number of observation coordinates for a site (for the soil)
92	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: nvar !< number of sampled variables at a site
93	!
94	!-- NetCDF varialbes
95	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: nc_id !< NetCDF file ID
96	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: id_position !< NetCDF dimension ID for vm position
97	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: id_position_soil !< NetCDF dimension ID for vm position in soil
98	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: id_time !< NetCDF dimension ID for time
99	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: id_var_eutm !< NetCDF variable ID for E_UTM
100	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: id_var_nutm !< NetCDF variable ID for N_UTM
101	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: id_var_hao !< NetCDF variable ID for the height coordinate
102	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: id_var_eutm_soil !< NetCDF variable ID for E_UTM for soil quantity
103	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: id_var_nutm_soil !< NetCDF variable ID for N_UTM for soil quantity
104	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: id_var_depth !< NetCDF variable ID for soil depth
105	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: id_var_time !< NetCDF variable ID for the time coordinate
106	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: start_count_time !< NetCDF start index for the time dimension
107	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: start_count_utm !< NetCDF start index for the UTM dimension
108	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: start_count_utm_soil !< NetCDF start index for the UTM dimension in the soil
109
110	INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: id_var !< NetCDF variable IDs for the sampled variables at a site
111
112	LOGICAL, DIMENSION(:), ALLOCATABLE :: soil !< flag indicating sampled soil quantities
113
114	REAL(wp) :: output_time !< output time
115	REAL(wp), DIMENSION(:), ALLOCATABLE :: var !< sampled data
116	REAL(wp), DIMENSION(:), ALLOCATABLE :: var_soil !< sampled data of a soil varialbe
117	REAL(wp), DIMENSION(:), ALLOCATABLE :: origin_x_obs !< site coordinate (x)
118	REAL(wp), DIMENSION(:), ALLOCATABLE :: origin_y_obs !< site coordinate (y)
119	REAL(wp), DIMENSION(:), ALLOCATABLE :: e_utm !< E_UTM coordinates where measurements were taken
120	REAL(wp), DIMENSION(:), ALLOCATABLE :: n_utm !< N_UTM coordinates where measurements were taken
121	REAL(wp), DIMENSION(:), ALLOCATABLE :: z_ag !< height coordinates where measurements were taken
122	REAL(wp), DIMENSION(:), ALLOCATABLE :: e_utm_soil !< E_UTM coordinates where measurements were taken (soil)
123	REAL(wp), DIMENSION(:), ALLOCATABLE :: n_utm_soil !< N_UTM coordinates where measurements were taken (soil)
124	REAL(wp), DIMENSION(:), ALLOCATABLE :: depth !< soil depth where measurements were taken (soil)
125
126	!
127	!-- Read namelist.
128	CALL cvm_parin
129	!
130	!-- Create filename suffix of the treated binary file.
131	f = 0
132	CALL create_file_string
133	!
134	!-- Open binary file for processor 0.
135	OPEN ( file_id_in, FILE = TRIM( path_input ) // TRIM( run ) // &
136	TRIM( myid_char ), FORM = 'UNFORMATTED' )
137	!
138	!-- Reader global information, such as number of stations, their type,
139	!-- number of observation coordinates for each station on subdomain and
140	!-- total. Read number of sites.
141	READ( file_id_in ) char_in
142	READ( file_id_in ) nvm
143	!
144	!-- Allocate arrays required to describe measurements
145	ALLOCATE( site(1:nvm) )
146	ALLOCATE( filename(1:nvm) )
147	ALLOCATE( feature_type(1:nvm) )
148	ALLOCATE( soil_quantity(1:nvm) )
149	ALLOCATE( nvar(1:nvm) )
150	ALLOCATE( origin_x_obs(1:nvm) )
151	ALLOCATE( origin_y_obs(1:nvm) )
152	ALLOCATE( ns(1:nvm) )
153	ALLOCATE( ns_tot(1:nvm) )
154	ALLOCATE( ns_soil(1:nvm) )
155	ALLOCATE( ns_soil_tot(1:nvm) )
156	ALLOCATE( soil(1:nvm) )
157
158	ns_soil = 0
159	ns_soil_tot = 0
160	!
161	!-- Allocate array with the measured variables at each station
162	ALLOCATE( variables(1:100,1:nvm) )
163	!
164	!-- Allocate arrays for NetCDF IDs
165	ALLOCATE( nc_id(1:nvm) )
166	ALLOCATE( id_position(1:nvm) )
167	ALLOCATE( id_position_soil(1:nvm) )
168	ALLOCATE( id_time(1:nvm) )
169	ALLOCATE( id_var_eutm(1:nvm) )
170	ALLOCATE( id_var_nutm(1:nvm) )
171	ALLOCATE( id_var_hao(1:nvm) )
172	ALLOCATE( id_var_eutm_soil(1:nvm) )
173	ALLOCATE( id_var_nutm_soil(1:nvm) )
174	ALLOCATE( id_var_depth(1:nvm) )
175	ALLOCATE( id_var_time(1:nvm) )
176	ALLOCATE( id_var(1:50,1:nvm) )
177	id_var = 0
178	nc_id = 0
179	!
180	!-- Allocate arrays that contain information about the start index in the
181	!-- dimension array, used to write binary data at the correct position in
182	!-- the NetCDF file.
183	ALLOCATE( start_count_utm(1:nvm) )
184	ALLOCATE( start_count_utm_soil(1:nvm) )
185
186	ALLOCATE( start_count_time(1:nvm) )
187	!
188	!-- Read further global information from processor 0, such as filenames,
189	!-- global attributes, dimension sizes, etc. used to create NetCDF files.
190	DO l = 1, nvm
191	!
192	!-- Read sitename
193	READ( file_id_in ) char_in
194	READ( file_id_in ) site(l)
195	!
196	!-- Read filename (original name where real-world data is stored)
197	READ( file_id_in ) char_in
198	READ( file_id_in ) filename(l)
199	!
200	!-- Read type of the measurement
201	READ( file_id_in ) char_in
202	READ( file_id_in ) feature_type(l)
203	!
204	!-- Read x-y origin coordinates (in UTM)
205	READ( file_id_in ) char_in
206	READ( file_id_in ) origin_x_obs(l)
207	READ( file_id_in ) char_in
208	READ( file_id_in ) origin_y_obs(l)
209	!
210	!-- Read total number of observation grid points (dimension size of the
211	!-- virtual measurement)
212	READ( file_id_in ) char_in
213	READ( file_id_in ) ns_tot(l)
214	!
215	!-- Read number of observed quantities at each station
216	READ( file_id_in ) char_in
217	READ( file_id_in ) nvar(l)
218	!
219	!-- Read names of observed quantities
220	READ( file_id_in ) char_in
221	READ( file_id_in ) variables(1:nvar(l),l)
222	!
223	!-- Further dummy arguments are read (number of observation points
224	!-- on subdomains and its UTM coordinates).
225	READ( file_id_in ) char_in
226	READ( file_id_in ) ns(l)
227
228	ALLOCATE( e_utm(1:ns(l)) )
229	ALLOCATE( n_utm(1:ns(l)) )
230	ALLOCATE( z_ag(1:ns(l)) )
231	!
232	!-- Read the local coordinate arrays
233	READ( file_id_in ) char_in
234	READ( file_id_in ) e_utm
235
236	READ( file_id_in ) char_in
237	READ( file_id_in ) n_utm
238
239	READ( file_id_in ) char_in
240	READ( file_id_in ) z_ag
241
242	DEALLOCATE( e_utm )
243	DEALLOCATE( n_utm )
244	DEALLOCATE( z_ag )
245
246	!
247	!-- Read flag indicating whether soil data is also present or not
248	READ( file_id_in ) char_in
249	READ( file_id_in ) char_in
250
251	soil(l) = MERGE( .TRUE., .FALSE., TRIM( char_in ) == "yes" )
252
253	IF ( soil(l) ) THEN
254
255	READ( file_id_in ) char_in
256	READ( file_id_in ) ns_soil_tot(l)
257
258	READ( file_id_in ) char_in
259	READ( file_id_in ) ns_soil(l)
260
261	ALLOCATE( e_utm_soil(1:ns_soil(l)) )
262	ALLOCATE( n_utm_soil(1:ns_soil(l)) )
263	ALLOCATE( depth(1:ns_soil(l)) )
264	!
265	!-- Read the local coordinate arrays
266	READ( file_id_in ) char_in
267	READ( file_id_in ) e_utm_soil
268
269	READ( file_id_in ) char_in
270	READ( file_id_in ) n_utm_soil
271
272	READ( file_id_in ) char_in
273	READ( file_id_in ) depth
274
275	DEALLOCATE( e_utm_soil )
276	DEALLOCATE( n_utm_soil )
277	DEALLOCATE( depth )
278
279	ENDIF
280	!
281	!-- Create netcdf file and setup header information
282	CALL netcdf_create_file
283
284	ENDDO
285	!
286	!-- Close binary file created by processor 0.
287	CLOSE( file_id_in )
288	!
289	!-- Initialize UTM coordinate start index
290	start_count_utm = 1
291	start_count_utm_soil = 1
292	!
293	!-- Read data from all PEs and write into file
294	DO f = 0, num_pe - 1
295	!
296	!-- Create filename suffix of the treated binary file.
297	CALL create_file_string
298	!
299	!-- Open binary file for processor f.
300	OPEN ( file_id_in, FILE = TRIM( path_input ) // TRIM( run ) // &
301	TRIM( myid_char ), FORM = 'UNFORMATTED' )
302	!
303	!-- Initialize time coordinate start index
304	start_count_time = 1
305	!
306	!-- Reader global information, such as number of stations, their type,
307	!-- number of observation coordinates for each station on subdomain and
308	!-- total.
309	!-- Again, read number of sites.
310	READ( file_id_in ) char_in
311	READ( file_id_in ) nvm
312
313	DO l = 1, nvm
314	!
315	!-- Read sitename
316	READ( file_id_in ) char_in
317	READ( file_id_in ) site(l)
318	!
319	!-- Read filename (original name where real-world data is stored)
320	READ( file_id_in ) char_in
321	READ( file_id_in ) filename(l)
322	!
323	!-- Read type of the measurement
324	READ( file_id_in ) char_in
325	READ( file_id_in ) feature_type(l)
326	!
327	!-- Read x-y origin coordinates (in UTM)
328	READ( file_id_in ) char_in
329	READ( file_id_in ) origin_x_obs(l)
330	READ( file_id_in ) char_in
331	READ( file_id_in ) origin_y_obs(l)
332	!
333	!-- Read total number of observation grid points (dimension size of the
334	!-- virtual measurement)
335	READ( file_id_in ) char_in
336	READ( file_id_in ) ns_tot(l)
337	!
338	!-- Read number of observed quantities at each station
339	READ( file_id_in ) char_in
340	READ( file_id_in ) nvar(l)
341	!
342	!-- Read names of observed quantities
343	READ( file_id_in ) char_in
344	READ( file_id_in ) variables(1:nvar(l),l)
345	!
346	!-- Further dummy arguments are read (number of observation points
347	!-- on subdomains and its UTM coordinates).
348	READ( file_id_in ) char_in
349	READ( file_id_in ) ns(l)
350
351	ALLOCATE( e_utm(1:ns(l)) )
352	ALLOCATE( n_utm(1:ns(l)) )
353	ALLOCATE( z_ag(1:ns(l)) )
354	!
355	!-- Read the local coordinate arrays
356	READ( file_id_in ) char_in
357	READ( file_id_in ) e_utm
358
359	READ( file_id_in ) char_in
360	READ( file_id_in ) n_utm
361
362	READ( file_id_in ) char_in
363	READ( file_id_in ) z_ag
364	!
365	!-- Read flag indicating whether soil data is also present or not
366	READ( file_id_in ) char_in
367	READ( file_id_in ) char_in
368
369	soil(l) = MERGE( .TRUE., .FALSE., TRIM( char_in ) == "yes" )
370
371	IF ( soil(l) ) THEN
372
373	READ( file_id_in ) char_in
374	READ( file_id_in ) ns_soil_tot(l)
375
376	READ( file_id_in ) char_in
377	READ( file_id_in ) ns_soil(l)
378
379	ALLOCATE( e_utm_soil(1:ns_soil(l)) )
380	ALLOCATE( n_utm_soil(1:ns_soil(l)) )
381	ALLOCATE( depth(1:ns_soil(l)) )
382	!
383	!-- Read the local coordinate arrays
384	READ( file_id_in ) char_in
385	READ( file_id_in ) e_utm_soil
386
387	READ( file_id_in ) char_in
388	READ( file_id_in ) n_utm_soil
389
390	READ( file_id_in ) char_in
391	READ( file_id_in ) depth
392
393	ENDIF
394	!
395	!-- Write the spatial coordinates to the NetCDF file
396	CALL netcdf_write_spatial_coordinates
397
398	DEALLOCATE( e_utm )
399	DEALLOCATE( n_utm )
400	DEALLOCATE( z_ag )
401
402	IF ( soil(l) ) THEN
403	DEALLOCATE( e_utm_soil )
404	DEALLOCATE( n_utm_soil )
405	DEALLOCATE( depth )
406	ENDIF
407
408	ENDDO
409	!
410	!-- Read the actual data, starting with the identification string for the
411	!-- output time
412	READ( file_id_in ) char_in
413	DO WHILE ( TRIM( char_in ) == 'output time')
414
415	READ( file_id_in ) output_time
416	!
417	!-- Loop over all sites
418	DO l = 1, nvm
419	!
420	!-- Cycle loop if no observation coordinates are on local subdomain
421	IF ( ns(l) < 1 .AND. ns_soil(l) < 1 ) CYCLE
422	!
423	!-- Write time coordinate
424	CALL netcdf_write_time_coordinate
425	!
426	!-- Read the actual data, therefore, allocate appropriate array with
427	!-- size of the subdomain coordinates. Output data immediately into
428	!-- NetCDF file.
429	ALLOCATE( var(1:ns(l)) )
430	IF ( soil(l) ) ALLOCATE( var_soil(1:ns_soil(l)) )
431
432	DO n = 1, nvar(l)
433	READ( file_id_in ) variables(n,l)
434	IF ( soil(l) .AND. &
435	ANY( TRIM( variables(n,l) ) == soil_quantities ) ) THEN
436	READ( file_id_in ) var_soil
437	ELSE
438	READ( file_id_in ) var
439	ENDIF
440	!
441	!-- Write data to NetCDF file
442	CALL netcdf_data_output
443	ENDDO
444
445	DEALLOCATE( var )
446	IF( ALLOCATED(var_soil) ) DEALLOCATE( var_soil )
447	!
448	!-- Increment NetCDF index of the time coordinate
449	start_count_time(l) = start_count_time(l) + 1
450	ENDDO
451	!
452	!-- Read next identification string
453	READ( file_id_in ) char_in
454
455	ENDDO
456	!
457	!-- After data from processor f is read and output into NetCDF file,
458	!-- the start index of the UTM coordinate array need to be incremented
459	start_count_utm = start_count_utm + ns
460	start_count_utm_soil = start_count_utm_soil + ns_soil
461	!
462	!-- Close binary file for processor f
463	CLOSE( file_id_in )
464	ENDDO
465	!
466	!-- Close Netcdf files
467	DO l = 1, nvm
468	CALL netcdf_close_file
469	ENDDO
470
471	CONTAINS
472
473	!------------------------------------------------------------------------------!
474	! Description:
475	! ------------
476	!> This subroutine read the namelist file.
477	!------------------------------------------------------------------------------!
478	SUBROUTINE cvm_parin
479
480	IMPLICIT NONE
481
482	INTEGER(iwp) :: file_id_parin = 90
483
484	NAMELIST /vm/ cycle_number, num_pe, path_input, path_output, run
485
486	!
487	!-- Open namelist file.
488	OPEN( file_id_parin, FILE='vm_parin', STATUS='OLD', FORM='FORMATTED')
489	!
490	!-- Read namelist.
491	READ ( file_id_parin, vm )
492	!
493	!-- Close namelist file.
494	CLOSE( file_id_parin )
495
496	END SUBROUTINE cvm_parin
497
498	!------------------------------------------------------------------------------!
499	! Description:
500	! ------------
501	!> This subroutine creates the filename string of the treated binary file.
502	!------------------------------------------------------------------------------!
503	SUBROUTINE create_file_string
504
505	IMPLICIT NONE
506
507	CHARACTER(LEN=4) :: char_cycle = '' !< dummy string for cycle number
508	CHARACTER(LEN=10) :: char_dum !< dummy string for processor ID
509
510	!
511	!-- Create substring for the cycle number.
512	IF ( cycle_number /= 0 ) THEN
513	IF ( cycle_number < 10 ) THEN
514	WRITE( char_cycle, '(I1)') cycle_number
515	char_cycle = '.00' // TRIM( char_cycle )
516	ELSEIF ( cycle_number < 100 ) THEN
517	WRITE( char_cycle, '(I2)') cycle_number
518	char_cycle = '.0' // TRIM( char_cycle )
519	ELSEIF ( cycle_number < 1000 ) THEN
520	WRITE( char_cycle, '(I3)') cycle_number
521	char_cycle = '.' // TRIM( char_cycle )
522	ENDIF
523	ENDIF
524	!
525	!-- Create substring for the processor id and combine all substrings.
526	IF ( f < 10 ) THEN
527	WRITE( char_dum, '(I1)') f
528	myid_char = '_vmeas_00000' // TRIM( char_dum ) // &
529	TRIM( char_cycle ) // file_suffix
530	ELSEIF ( f < 100 ) THEN
531	WRITE( char_dum, '(I2)') f
532	myid_char = '_vmeas_0000' // TRIM( char_dum ) // &
533	TRIM( char_cycle ) // file_suffix
534	ELSEIF ( f < 1000 ) THEN
535	WRITE( char_dum, '(I3)') f
536	myid_char = '_vmeas_000' // TRIM( char_dum ) // &
537	TRIM( char_cycle ) // file_suffix
538	ELSEIF ( f < 10000 ) THEN
539	WRITE( char_dum, '(I4)') f
540	myid_char = '_vmeas_00' // TRIM( char_dum ) // &
541	TRIM( char_cycle ) // file_suffix
542	ELSEIF ( f < 100000 ) THEN
543	WRITE( char_dum, '(I5)') f
544	myid_char = '_vmeas_0' // TRIM( char_dum ) // &
545	TRIM( char_cycle ) // file_suffix
546	ELSEIF ( f < 1000000 ) THEN
547	WRITE( char_dum, '(I6)') f
548	myid_char = '_vmeas_' // TRIM( char_dum ) // &
549	TRIM( char_cycle ) // file_suffix
550	ENDIF
551
552	END SUBROUTINE create_file_string
553
554
555	!------------------------------------------------------------------------------!
556	! Description:
557	! ------------
558	!> This subroutine creates the NetCDF file and defines dimesions and varialbes.
559	!------------------------------------------------------------------------------!
560	SUBROUTINE netcdf_create_file
561
562	IMPLICIT NONE
563
564
565	CHARACTER(LEN=5) :: char_cycle = '' !< dummy string for cycle number
566	CHARACTER(LEN=200) :: nc_filename = '' !< NetCDF filename
567
568	!
569	!-- Create substring for the cycle number.
570	IF ( cycle_number /= 0 ) THEN
571	IF ( cycle_number < 10 ) THEN
572	WRITE( char_cycle, '(I1)') cycle_number
573	char_cycle = '.00' // TRIM( char_cycle ) // '.'
574	ELSEIF ( cycle_number < 100 ) THEN
575	WRITE( char_cycle, '(I2)') cycle_number
576	char_cycle = '.0' // TRIM( char_cycle ) // '.'
577	ELSEIF ( cycle_number < 1000 ) THEN
578	WRITE( char_cycle, '(I3)') cycle_number
579	char_cycle = '.' // TRIM( char_cycle ) // '.'
580	ENDIF
581	ELSE
582	char_cycle = '.'
583	ENDIF
584	#if defined( __netcdf )
585
586	nc_filename = site(l)(1:LEN_TRIM(site(l))-1) // '_palm4U' // &
587	TRIM( char_cycle ) // 'nc'
588	!
589	!-- Create NetCDF file
590	status_nc = NF90_CREATE( TRIM(path_output) // &
591	nc_filename(1:LEN_TRIM(nc_filename)), &
592	IOR( NF90_CLOBBER, NF90_NETCDF4 ), nc_id(l) )
593	CALL handle_error( "create file" )
594	!
595	!-- Define attributes
596	status_nc = NF90_PUT_ATT( nc_id(l), NF90_GLOBAL, "featureType", &
597	TRIM( feature_type(l) ) )
598	CALL handle_error( "define attribue featureType" )
599
600	status_nc = NF90_PUT_ATT( nc_id(l), NF90_GLOBAL, "origin_x", &
601	origin_x_obs(l) )
602	CALL handle_error( "define attribue origin_x" )
603
604	status_nc = NF90_PUT_ATT( nc_id(l), NF90_GLOBAL, "origin_y", &
605	origin_y_obs(l) )
606	CALL handle_error( "define attribue origin_y" )
607
608	status_nc = NF90_PUT_ATT( nc_id(l), NF90_GLOBAL, "site", &
609	TRIM( site(l) ) )
610	CALL handle_error( "define attribue site" )
611	!
612	!-- Define dimensions
613	status_nc = NF90_DEF_DIM( nc_id(l), 'time', NF90_UNLIMITED, id_time(l) )
614	CALL handle_error( "define dimension time" )
615
616	status_nc = NF90_DEF_DIM( nc_id(l), 'position', ns_tot(l), &
617	id_position(l) )
618	CALL handle_error( "define dimension position" )
619
620	IF ( soil(l) ) THEN
621	status_nc = NF90_DEF_DIM( nc_id(l), 'position_soil', ns_soil_tot(l), &
622	id_position_soil(l) )
623	CALL handle_error( "define dimension position_soil" )
624	ENDIF
625	!
626	!-- Define coordinate variables
627	status_nc = NF90_DEF_VAR( nc_id(l), 'E_UTM', NF90_DOUBLE, &
628	(/ id_position(l) /), id_var_eutm(l) )
629	CALL handle_error( "define variable E_UTM" )
630
631	status_nc = NF90_DEF_VAR( nc_id(l), 'N_UTM', NF90_DOUBLE, &
632	(/ id_position(l) /), id_var_nutm(l) )
633	CALL handle_error( "define variable N_UTM" )
634
635	status_nc = NF90_DEF_VAR( nc_id(l), 'height_above_origin', NF90_DOUBLE, &
636	(/ id_position(l) /), id_var_hao(l) )
637	CALL handle_error( "define variable height_above_origin" )
638
639	status_nc = NF90_DEF_VAR( nc_id(l), 'time', NF90_DOUBLE, &
640	(/ id_time(l) /), id_var_time(l) )
641	CALL handle_error( "define variable time" )
642
643	IF ( soil(l) ) THEN
644	status_nc = NF90_DEF_VAR( nc_id(l), 'E_UTM soil', NF90_DOUBLE, &
645	(/ id_position_soil(l) /), &
646	id_var_eutm_soil(l) )
647	CALL handle_error( "define variable E_UTM soil" )
648
649	status_nc = NF90_DEF_VAR( nc_id(l), 'N_UTM soil', NF90_DOUBLE, &
650	(/ id_position_soil(l) /), &
651	id_var_nutm_soil(l) )
652	CALL handle_error( "define variable N_UTM soil" )
653
654	status_nc = NF90_DEF_VAR( nc_id(l), 'depth', NF90_DOUBLE, &
655	(/ id_position_soil(l) /), &
656	id_var_depth(l) )
657	CALL handle_error( "define variable depth" )
658	ENDIF
659	!
660	!-- Define the measured quantities
661	DO n = 1, nvar(l)
662	IF ( soil(l) .AND. &
663	ANY( TRIM( variables(n,l) ) == soil_quantities ) ) THEN
664	status_nc = NF90_DEF_VAR( nc_id(l), TRIM( variables(n,l) ), &
665	NF90_DOUBLE, &
666	(/ id_time(l), id_position_soil(l) /), &
667	id_var(n,l) )
668	CALL handle_error( "define variable " // TRIM( variables(n,l) ) )
669	ELSE
670	status_nc = NF90_DEF_VAR( nc_id(l), TRIM( variables(n,l) ), &
671	NF90_DOUBLE, &
672	(/ id_time(l), id_position(l) /), &
673	id_var(n,l) )
674	CALL handle_error( "define variable " // TRIM( variables(n,l) ) )
675	ENDIF
676	ENDDO
677	#endif
678	END SUBROUTINE netcdf_create_file
679
680	!------------------------------------------------------------------------------!
681	! Description:
682	! ------------
683	!> This subroutine closes a NetCDF file.
684	!------------------------------------------------------------------------------!
685	SUBROUTINE netcdf_close_file
686
687	IMPLICIT NONE
688
689	#if defined( __netcdf )
690	status_nc = NF90_CLOSE( nc_id(l) )
691	CALL handle_error( "close file" )
692	#endif
693
694	END SUBROUTINE netcdf_close_file
695
696	!------------------------------------------------------------------------------!
697	! Description:
698	! ------------
699	!> This subroutine writes the spatial coordinates
700	!------------------------------------------------------------------------------!
701	SUBROUTINE netcdf_write_spatial_coordinates
702
703	IMPLICIT NONE
704
705	!
706	!-- Write coordinates
707	#if defined( __netcdf )
708	status_nc = NF90_PUT_VAR( nc_id(l), id_var_eutm(l), e_utm, &
709	start = (/ start_count_utm(l) /), &
710	count = (/ ns(l) /) )
711	CALL handle_error( "write variable E_UTM" )
712
713	status_nc = NF90_PUT_VAR( nc_id(l), id_var_nutm(l), n_utm, &
714	start = (/ start_count_utm(l) /), &
715	count = (/ ns(l) /) )
716	CALL handle_error( "write variable N_UTM" )
717
718	status_nc = NF90_PUT_VAR( nc_id(l), id_var_hao(l), z_ag, &
719	start = (/ start_count_utm(l) /), &
720	count = (/ ns(l) /) )
721	CALL handle_error( "write variable height_above_origin" )
722
723	IF ( soil(l) ) THEN
724	status_nc = NF90_PUT_VAR( nc_id(l), id_var_eutm_soil(l), e_utm_soil, &
725	start = (/ start_count_utm_soil(l) /), &
726	count = (/ ns_soil(l) /) )
727	CALL handle_error( "write variable E_UTM soil" )
728
729	status_nc = NF90_PUT_VAR( nc_id(l), id_var_nutm_soil(l), n_utm_soil, &
730	start = (/ start_count_utm_soil(l) /), &
731	count = (/ ns_soil(l) /) )
732	CALL handle_error( "write variable N_UTM soil" )
733
734	status_nc = NF90_PUT_VAR( nc_id(l), id_var_depth(l), depth, &
735	start = (/ start_count_utm_soil(l) /), &
736	count = (/ ns_soil(l) /) )
737	CALL handle_error( "write variable depth" )
738	ENDIF
739	!
740	!-- End of NetCDF file definition
741	status_nc = NF90_ENDDEF( nc_id(l) )
742	#endif
743	END SUBROUTINE netcdf_write_spatial_coordinates
744
745	!------------------------------------------------------------------------------!
746	! Description:
747	! ------------
748	!> This subroutine writes another time step to the unlimited time dimension.
749	!------------------------------------------------------------------------------!
750	SUBROUTINE netcdf_write_time_coordinate
751
752	IMPLICIT NONE
753
754	#if defined( __netcdf )
755	status_nc = NF90_PUT_VAR( nc_id(l), id_var_time(l), (/ output_time /), &
756	start = (/ start_count_time(l) /), &
757	count = (/ 1 /) )
758	CALL handle_error( "write variable time" )
759	#endif
760
761	END SUBROUTINE netcdf_write_time_coordinate
762
763
764	!------------------------------------------------------------------------------!
765	! Description:
766	! ------------
767	!> This subroutine writes the sampled variable to the NetCDF file.
768	!------------------------------------------------------------------------------!
769	SUBROUTINE netcdf_data_output
770
771	IMPLICIT NONE
772
773
774	IF ( soil(l) .AND. &
775	ANY( TRIM( variables(n,l) ) == soil_quantities ) ) THEN
776	status_nc = NF90_PUT_VAR( nc_id(l), id_var(n,l), (/ var_soil /), &
777	start = (/ start_count_time(l), &
778	start_count_utm_soil(l) /), &
779	count = (/ 1, ns_soil(l) /) )
780	CALL handle_error( "write variable " // TRIM( variables(n,l) ) )
781	ELSE
782	status_nc = NF90_PUT_VAR( nc_id(l), id_var(n,l), (/ var /), &
783	start = (/ start_count_time(l), &
784	start_count_utm(l) /), &
785	count = (/ 1, ns(l) /) )
786	CALL handle_error( "write variable " // TRIM( variables(n,l) ) )
787	ENDIF
788
789	END SUBROUTINE netcdf_data_output
790
791	!------------------------------------------------------------------------------!
792	! Description:
793	! ------------
794	!> NetCDF error handling.
795	!------------------------------------------------------------------------------!
796	SUBROUTINE handle_error( action )
797
798	IMPLICIT NONE
799
800	CHARACTER(LEN=*) :: action !< string indicating the current file action
801
802	#if defined( __netcdf )
803	IF ( status_nc /= NF90_NOERR ) THEN
804	PRINT*, TRIM( NF90_STRERROR( status_nc ) ) // ' -- ' // action
805	STOP
806	ENDIF
807	#endif
808
809	END SUBROUTINE handle_error
810
811	END PROGRAM combine_virtual_measurements

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |