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

Last change on this file since 3704 was 3704, checked in by suehring, 3 years ago

Revision of virtual-measurement module and data output enabled. Further, post-processing tool added to merge distributed virtually sampled data and to output it into NetCDF files.

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