Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |