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

Last change on this file since 4002 was 3928, checked in by gronemeier, 5 years ago

change dimensions in NetCDF output files of virtual measurements; add output path to namelist

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