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

Last change on this file since 3801 was 3705, checked in by suehring, 5 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 eckhard $
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.