!> @file combine_virtual_measurements.f90 !------------------------------------------------------------------------------! ! This file is part of the PALM model system. ! ! PALM is free software: you can redistribute it and/or modify it under the ! terms of the GNU General Public License as published by the Free Software ! Foundation, either version 3 of the License, or (at your option) any later ! version. ! ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR ! A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License along with ! PALM. If not, see . ! ! Copyright 1997-2018 Leibniz Universitaet Hannover !------------------------------------------------------------------------------! ! ! Current revisions: ! ----------------- ! ! ! Former revisions: ! ----------------- ! $Id: combine_virtual_measurements.f90 3928 2019-04-23 20:58:53Z suehring $ ! rename subroutines ! remove space dimensions; add positions dimension ! add output path to namelist ! ! 3705 2019-01-29 19:56:39Z suehring ! Initial revsion ! ! 3704 2019-01-29 19:51:41Z suehring ! ! Authors: ! -------- ! @author Matthias Suehring ! ! !------------------------------------------------------------------------------! ! Description: ! ------------ !> This routines merges binary output from virtual measurements taken from !> different subdomains and creates a NetCDF output file according to the (UC)2 !> data standard. !------------------------------------------------------------------------------! PROGRAM combine_virtual_measurements #if defined( __netcdf ) USE NETCDF #endif IMPLICIT NONE CHARACTER(LEN=34) :: char_in !< dummy string CHARACTER(LEN=4) :: file_suffix = '.bin' !< string which contain the suffix indicating virtual measurement data CHARACTER(LEN=30) :: myid_char !< combined string indicating binary file CHARACTER(LEN=100) :: path_input !< path to the binary input data CHARACTER(LEN=100) :: path_output !< path to the netcdf output files CHARACTER(LEN=100) :: run !< name of the run CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: site !< name of the site CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: filename !< name of the original file CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: feature_type !< string indicating the type of the measurement CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: soil_quantity !< string indicating soil measurements CHARACTER(LEN=10), DIMENSION(:,:), ALLOCATABLE :: variables !< list of measured variables CHARACTER(LEN=6), DIMENSION(5) :: soil_quantities = (/ & !< list of measurable soil variables "t_soil", & "m_soil", & "lwc ", & "lwcs ", & "smp " /) INTEGER, PARAMETER :: iwp = 4 !< integer precision INTEGER, PARAMETER :: wp = 8 !< float precision INTEGER(iwp) :: cycle_number !< cycle number INTEGER(iwp) :: f !< running index over all binary files INTEGER(iwp) :: file_id_in = 18 !< file unit for input binaray file INTEGER(iwp) :: l !< running index indicating the actual site INTEGER(iwp) :: n !< running index over all variables measured at a site INTEGER(iwp) :: num_pe !< number of processors used for the run INTEGER(iwp) :: nvm !< number of sites INTEGER(iwp) :: status_nc !< NetCDF error code, return value INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: ns !< number of observation coordinates on current subdomain INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: ns_tot !< total number of observation coordinates for a site INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: ns_soil !< number of observation coordinates for soil quantities (on current subdomain) INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: ns_soil_tot !< total number of observation coordinates for a site (for the soil) INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: nvar !< number of sampled variables at a site ! !-- NetCDF varialbes INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: nc_id !< NetCDF file ID INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: id_position !< NetCDF dimension ID for vm position INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: id_position_soil !< NetCDF dimension ID for vm position in soil INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: id_time !< NetCDF dimension ID for time INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: id_var_eutm !< NetCDF variable ID for E_UTM INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: id_var_nutm !< NetCDF variable ID for N_UTM INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: id_var_hao !< NetCDF variable ID for the height coordinate INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: id_var_eutm_soil !< NetCDF variable ID for E_UTM for soil quantity INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: id_var_nutm_soil !< NetCDF variable ID for N_UTM for soil quantity INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: id_var_depth !< NetCDF variable ID for soil depth INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: id_var_time !< NetCDF variable ID for the time coordinate INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: start_count_time !< NetCDF start index for the time dimension INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: start_count_utm !< NetCDF start index for the UTM dimension INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: start_count_utm_soil !< NetCDF start index for the UTM dimension in the soil INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: id_var !< NetCDF variable IDs for the sampled variables at a site LOGICAL, DIMENSION(:), ALLOCATABLE :: soil !< flag indicating sampled soil quantities REAL(wp) :: output_time !< output time REAL(wp), DIMENSION(:), ALLOCATABLE :: var !< sampled data REAL(wp), DIMENSION(:), ALLOCATABLE :: var_soil !< sampled data of a soil varialbe REAL(wp), DIMENSION(:), ALLOCATABLE :: origin_x_obs !< site coordinate (x) REAL(wp), DIMENSION(:), ALLOCATABLE :: origin_y_obs !< site coordinate (y) REAL(wp), DIMENSION(:), ALLOCATABLE :: e_utm !< E_UTM coordinates where measurements were taken REAL(wp), DIMENSION(:), ALLOCATABLE :: n_utm !< N_UTM coordinates where measurements were taken REAL(wp), DIMENSION(:), ALLOCATABLE :: z_ag !< height coordinates where measurements were taken REAL(wp), DIMENSION(:), ALLOCATABLE :: e_utm_soil !< E_UTM coordinates where measurements were taken (soil) REAL(wp), DIMENSION(:), ALLOCATABLE :: n_utm_soil !< N_UTM coordinates where measurements were taken (soil) REAL(wp), DIMENSION(:), ALLOCATABLE :: depth !< soil depth where measurements were taken (soil) ! !-- Read namelist. CALL cvm_parin ! !-- Create filename suffix of the treated binary file. f = 0 CALL create_file_string ! !-- Open binary file for processor 0. OPEN ( file_id_in, FILE = TRIM( path_input ) // TRIM( run ) // & TRIM( myid_char ), FORM = 'UNFORMATTED' ) ! !-- Reader global information, such as number of stations, their type, !-- number of observation coordinates for each station on subdomain and !-- total. Read number of sites. READ( file_id_in ) char_in READ( file_id_in ) nvm ! !-- Allocate arrays required to describe measurements ALLOCATE( site(1:nvm) ) ALLOCATE( filename(1:nvm) ) ALLOCATE( feature_type(1:nvm) ) ALLOCATE( soil_quantity(1:nvm) ) ALLOCATE( nvar(1:nvm) ) ALLOCATE( origin_x_obs(1:nvm) ) ALLOCATE( origin_y_obs(1:nvm) ) ALLOCATE( ns(1:nvm) ) ALLOCATE( ns_tot(1:nvm) ) ALLOCATE( ns_soil(1:nvm) ) ALLOCATE( ns_soil_tot(1:nvm) ) ALLOCATE( soil(1:nvm) ) ns_soil = 0 ns_soil_tot = 0 ! !-- Allocate array with the measured variables at each station ALLOCATE( variables(1:100,1:nvm) ) ! !-- Allocate arrays for NetCDF IDs ALLOCATE( nc_id(1:nvm) ) ALLOCATE( id_position(1:nvm) ) ALLOCATE( id_position_soil(1:nvm) ) ALLOCATE( id_time(1:nvm) ) ALLOCATE( id_var_eutm(1:nvm) ) ALLOCATE( id_var_nutm(1:nvm) ) ALLOCATE( id_var_hao(1:nvm) ) ALLOCATE( id_var_eutm_soil(1:nvm) ) ALLOCATE( id_var_nutm_soil(1:nvm) ) ALLOCATE( id_var_depth(1:nvm) ) ALLOCATE( id_var_time(1:nvm) ) ALLOCATE( id_var(1:50,1:nvm) ) id_var = 0 nc_id = 0 ! !-- Allocate arrays that contain information about the start index in the !-- dimension array, used to write binary data at the correct position in !-- the NetCDF file. ALLOCATE( start_count_utm(1:nvm) ) ALLOCATE( start_count_utm_soil(1:nvm) ) ALLOCATE( start_count_time(1:nvm) ) ! !-- Read further global information from processor 0, such as filenames, !-- global attributes, dimension sizes, etc. used to create NetCDF files. DO l = 1, nvm ! !-- Read sitename READ( file_id_in ) char_in READ( file_id_in ) site(l) ! !-- Read filename (original name where real-world data is stored) READ( file_id_in ) char_in READ( file_id_in ) filename(l) ! !-- Read type of the measurement READ( file_id_in ) char_in READ( file_id_in ) feature_type(l) ! !-- Read x-y origin coordinates (in UTM) READ( file_id_in ) char_in READ( file_id_in ) origin_x_obs(l) READ( file_id_in ) char_in READ( file_id_in ) origin_y_obs(l) ! !-- Read total number of observation grid points (dimension size of the !-- virtual measurement) READ( file_id_in ) char_in READ( file_id_in ) ns_tot(l) ! !-- Read number of observed quantities at each station READ( file_id_in ) char_in READ( file_id_in ) nvar(l) ! !-- Read names of observed quantities READ( file_id_in ) char_in READ( file_id_in ) variables(1:nvar(l),l) ! !-- Further dummy arguments are read (number of observation points !-- on subdomains and its UTM coordinates). READ( file_id_in ) char_in READ( file_id_in ) ns(l) ALLOCATE( e_utm(1:ns(l)) ) ALLOCATE( n_utm(1:ns(l)) ) ALLOCATE( z_ag(1:ns(l)) ) ! !-- Read the local coordinate arrays READ( file_id_in ) char_in READ( file_id_in ) e_utm READ( file_id_in ) char_in READ( file_id_in ) n_utm READ( file_id_in ) char_in READ( file_id_in ) z_ag DEALLOCATE( e_utm ) DEALLOCATE( n_utm ) DEALLOCATE( z_ag ) ! !-- Read flag indicating whether soil data is also present or not READ( file_id_in ) char_in READ( file_id_in ) char_in soil(l) = MERGE( .TRUE., .FALSE., TRIM( char_in ) == "yes" ) IF ( soil(l) ) THEN READ( file_id_in ) char_in READ( file_id_in ) ns_soil_tot(l) READ( file_id_in ) char_in READ( file_id_in ) ns_soil(l) ALLOCATE( e_utm_soil(1:ns_soil(l)) ) ALLOCATE( n_utm_soil(1:ns_soil(l)) ) ALLOCATE( depth(1:ns_soil(l)) ) ! !-- Read the local coordinate arrays READ( file_id_in ) char_in READ( file_id_in ) e_utm_soil READ( file_id_in ) char_in READ( file_id_in ) n_utm_soil READ( file_id_in ) char_in READ( file_id_in ) depth DEALLOCATE( e_utm_soil ) DEALLOCATE( n_utm_soil ) DEALLOCATE( depth ) ENDIF ! !-- Create netcdf file and setup header information CALL netcdf_create_file ENDDO ! !-- Close binary file created by processor 0. CLOSE( file_id_in ) ! !-- Initialize UTM coordinate start index start_count_utm = 1 start_count_utm_soil = 1 ! !-- Read data from all PEs and write into file DO f = 0, num_pe - 1 ! !-- Create filename suffix of the treated binary file. CALL create_file_string ! !-- Open binary file for processor f. OPEN ( file_id_in, FILE = TRIM( path_input ) // TRIM( run ) // & TRIM( myid_char ), FORM = 'UNFORMATTED' ) ! !-- Initialize time coordinate start index start_count_time = 1 ! !-- Reader global information, such as number of stations, their type, !-- number of observation coordinates for each station on subdomain and !-- total. !-- Again, read number of sites. READ( file_id_in ) char_in READ( file_id_in ) nvm DO l = 1, nvm ! !-- Read sitename READ( file_id_in ) char_in READ( file_id_in ) site(l) ! !-- Read filename (original name where real-world data is stored) READ( file_id_in ) char_in READ( file_id_in ) filename(l) ! !-- Read type of the measurement READ( file_id_in ) char_in READ( file_id_in ) feature_type(l) ! !-- Read x-y origin coordinates (in UTM) READ( file_id_in ) char_in READ( file_id_in ) origin_x_obs(l) READ( file_id_in ) char_in READ( file_id_in ) origin_y_obs(l) ! !-- Read total number of observation grid points (dimension size of the !-- virtual measurement) READ( file_id_in ) char_in READ( file_id_in ) ns_tot(l) ! !-- Read number of observed quantities at each station READ( file_id_in ) char_in READ( file_id_in ) nvar(l) ! !-- Read names of observed quantities READ( file_id_in ) char_in READ( file_id_in ) variables(1:nvar(l),l) ! !-- Further dummy arguments are read (number of observation points !-- on subdomains and its UTM coordinates). READ( file_id_in ) char_in READ( file_id_in ) ns(l) ALLOCATE( e_utm(1:ns(l)) ) ALLOCATE( n_utm(1:ns(l)) ) ALLOCATE( z_ag(1:ns(l)) ) ! !-- Read the local coordinate arrays READ( file_id_in ) char_in READ( file_id_in ) e_utm READ( file_id_in ) char_in READ( file_id_in ) n_utm READ( file_id_in ) char_in READ( file_id_in ) z_ag ! !-- Read flag indicating whether soil data is also present or not READ( file_id_in ) char_in READ( file_id_in ) char_in soil(l) = MERGE( .TRUE., .FALSE., TRIM( char_in ) == "yes" ) IF ( soil(l) ) THEN READ( file_id_in ) char_in READ( file_id_in ) ns_soil_tot(l) READ( file_id_in ) char_in READ( file_id_in ) ns_soil(l) ALLOCATE( e_utm_soil(1:ns_soil(l)) ) ALLOCATE( n_utm_soil(1:ns_soil(l)) ) ALLOCATE( depth(1:ns_soil(l)) ) ! !-- Read the local coordinate arrays READ( file_id_in ) char_in READ( file_id_in ) e_utm_soil READ( file_id_in ) char_in READ( file_id_in ) n_utm_soil READ( file_id_in ) char_in READ( file_id_in ) depth ENDIF ! !-- Write the spatial coordinates to the NetCDF file CALL netcdf_write_spatial_coordinates DEALLOCATE( e_utm ) DEALLOCATE( n_utm ) DEALLOCATE( z_ag ) IF ( soil(l) ) THEN DEALLOCATE( e_utm_soil ) DEALLOCATE( n_utm_soil ) DEALLOCATE( depth ) ENDIF ENDDO ! !-- Read the actual data, starting with the identification string for the !-- output time READ( file_id_in ) char_in DO WHILE ( TRIM( char_in ) == 'output time') READ( file_id_in ) output_time ! !-- Loop over all sites DO l = 1, nvm ! !-- Cycle loop if no observation coordinates are on local subdomain IF ( ns(l) < 1 .AND. ns_soil(l) < 1 ) CYCLE ! !-- Write time coordinate CALL netcdf_write_time_coordinate ! !-- Read the actual data, therefore, allocate appropriate array with !-- size of the subdomain coordinates. Output data immediately into !-- NetCDF file. ALLOCATE( var(1:ns(l)) ) IF ( soil(l) ) ALLOCATE( var_soil(1:ns_soil(l)) ) DO n = 1, nvar(l) READ( file_id_in ) variables(n,l) IF ( soil(l) .AND. & ANY( TRIM( variables(n,l) ) == soil_quantities ) ) THEN READ( file_id_in ) var_soil ELSE READ( file_id_in ) var ENDIF ! !-- Write data to NetCDF file CALL netcdf_data_output ENDDO DEALLOCATE( var ) IF( ALLOCATED(var_soil) ) DEALLOCATE( var_soil ) ! !-- Increment NetCDF index of the time coordinate start_count_time(l) = start_count_time(l) + 1 ENDDO ! !-- Read next identification string READ( file_id_in ) char_in ENDDO ! !-- After data from processor f is read and output into NetCDF file, !-- the start index of the UTM coordinate array need to be incremented start_count_utm = start_count_utm + ns start_count_utm_soil = start_count_utm_soil + ns_soil ! !-- Close binary file for processor f CLOSE( file_id_in ) ENDDO ! !-- Close Netcdf files DO l = 1, nvm CALL netcdf_close_file ENDDO CONTAINS !------------------------------------------------------------------------------! ! Description: ! ------------ !> This subroutine read the namelist file. !------------------------------------------------------------------------------! SUBROUTINE cvm_parin IMPLICIT NONE INTEGER(iwp) :: file_id_parin = 90 NAMELIST /vm/ cycle_number, num_pe, path_input, path_output, run ! !-- Open namelist file. OPEN( file_id_parin, FILE='vm_parin', STATUS='OLD', FORM='FORMATTED') ! !-- Read namelist. READ ( file_id_parin, vm ) ! !-- Close namelist file. CLOSE( file_id_parin ) END SUBROUTINE cvm_parin !------------------------------------------------------------------------------! ! Description: ! ------------ !> This subroutine creates the filename string of the treated binary file. !------------------------------------------------------------------------------! SUBROUTINE create_file_string IMPLICIT NONE CHARACTER(LEN=4) :: char_cycle = '' !< dummy string for cycle number CHARACTER(LEN=10) :: char_dum !< dummy string for processor ID ! !-- Create substring for the cycle number. IF ( cycle_number /= 0 ) THEN IF ( cycle_number < 10 ) THEN WRITE( char_cycle, '(I1)') cycle_number char_cycle = '.00' // TRIM( char_cycle ) ELSEIF ( cycle_number < 100 ) THEN WRITE( char_cycle, '(I2)') cycle_number char_cycle = '.0' // TRIM( char_cycle ) ELSEIF ( cycle_number < 1000 ) THEN WRITE( char_cycle, '(I3)') cycle_number char_cycle = '.' // TRIM( char_cycle ) ENDIF ENDIF ! !-- Create substring for the processor id and combine all substrings. IF ( f < 10 ) THEN WRITE( char_dum, '(I1)') f myid_char = '_vmeas_00000' // TRIM( char_dum ) // & TRIM( char_cycle ) // file_suffix ELSEIF ( f < 100 ) THEN WRITE( char_dum, '(I2)') f myid_char = '_vmeas_0000' // TRIM( char_dum ) // & TRIM( char_cycle ) // file_suffix ELSEIF ( f < 1000 ) THEN WRITE( char_dum, '(I3)') f myid_char = '_vmeas_000' // TRIM( char_dum ) // & TRIM( char_cycle ) // file_suffix ELSEIF ( f < 10000 ) THEN WRITE( char_dum, '(I4)') f myid_char = '_vmeas_00' // TRIM( char_dum ) // & TRIM( char_cycle ) // file_suffix ELSEIF ( f < 100000 ) THEN WRITE( char_dum, '(I5)') f myid_char = '_vmeas_0' // TRIM( char_dum ) // & TRIM( char_cycle ) // file_suffix ELSEIF ( f < 1000000 ) THEN WRITE( char_dum, '(I6)') f myid_char = '_vmeas_' // TRIM( char_dum ) // & TRIM( char_cycle ) // file_suffix ENDIF END SUBROUTINE create_file_string !------------------------------------------------------------------------------! ! Description: ! ------------ !> This subroutine creates the NetCDF file and defines dimesions and varialbes. !------------------------------------------------------------------------------! SUBROUTINE netcdf_create_file IMPLICIT NONE CHARACTER(LEN=5) :: char_cycle = '' !< dummy string for cycle number CHARACTER(LEN=200) :: nc_filename = '' !< NetCDF filename ! !-- Create substring for the cycle number. IF ( cycle_number /= 0 ) THEN IF ( cycle_number < 10 ) THEN WRITE( char_cycle, '(I1)') cycle_number char_cycle = '.00' // TRIM( char_cycle ) // '.' ELSEIF ( cycle_number < 100 ) THEN WRITE( char_cycle, '(I2)') cycle_number char_cycle = '.0' // TRIM( char_cycle ) // '.' ELSEIF ( cycle_number < 1000 ) THEN WRITE( char_cycle, '(I3)') cycle_number char_cycle = '.' // TRIM( char_cycle ) // '.' ENDIF ELSE char_cycle = '.' ENDIF #if defined( __netcdf ) nc_filename = site(l)(1:LEN_TRIM(site(l))-1) // '_palm4U' // & TRIM( char_cycle ) // 'nc' ! !-- Create NetCDF file status_nc = NF90_CREATE( TRIM(path_output) // & nc_filename(1:LEN_TRIM(nc_filename)), & IOR( NF90_CLOBBER, NF90_NETCDF4 ), nc_id(l) ) CALL handle_error( "create file" ) ! !-- Define attributes status_nc = NF90_PUT_ATT( nc_id(l), NF90_GLOBAL, "featureType", & TRIM( feature_type(l) ) ) CALL handle_error( "define attribue featureType" ) status_nc = NF90_PUT_ATT( nc_id(l), NF90_GLOBAL, "origin_x", & origin_x_obs(l) ) CALL handle_error( "define attribue origin_x" ) status_nc = NF90_PUT_ATT( nc_id(l), NF90_GLOBAL, "origin_y", & origin_y_obs(l) ) CALL handle_error( "define attribue origin_y" ) status_nc = NF90_PUT_ATT( nc_id(l), NF90_GLOBAL, "site", & TRIM( site(l) ) ) CALL handle_error( "define attribue site" ) ! !-- Define dimensions status_nc = NF90_DEF_DIM( nc_id(l), 'time', NF90_UNLIMITED, id_time(l) ) CALL handle_error( "define dimension time" ) status_nc = NF90_DEF_DIM( nc_id(l), 'position', ns_tot(l), & id_position(l) ) CALL handle_error( "define dimension position" ) IF ( soil(l) ) THEN status_nc = NF90_DEF_DIM( nc_id(l), 'position_soil', ns_soil_tot(l), & id_position_soil(l) ) CALL handle_error( "define dimension position_soil" ) ENDIF ! !-- Define coordinate variables status_nc = NF90_DEF_VAR( nc_id(l), 'E_UTM', NF90_DOUBLE, & (/ id_position(l) /), id_var_eutm(l) ) CALL handle_error( "define variable E_UTM" ) status_nc = NF90_DEF_VAR( nc_id(l), 'N_UTM', NF90_DOUBLE, & (/ id_position(l) /), id_var_nutm(l) ) CALL handle_error( "define variable N_UTM" ) status_nc = NF90_DEF_VAR( nc_id(l), 'height_above_origin', NF90_DOUBLE, & (/ id_position(l) /), id_var_hao(l) ) CALL handle_error( "define variable height_above_origin" ) status_nc = NF90_DEF_VAR( nc_id(l), 'time', NF90_DOUBLE, & (/ id_time(l) /), id_var_time(l) ) CALL handle_error( "define variable time" ) IF ( soil(l) ) THEN status_nc = NF90_DEF_VAR( nc_id(l), 'E_UTM soil', NF90_DOUBLE, & (/ id_position_soil(l) /), & id_var_eutm_soil(l) ) CALL handle_error( "define variable E_UTM soil" ) status_nc = NF90_DEF_VAR( nc_id(l), 'N_UTM soil', NF90_DOUBLE, & (/ id_position_soil(l) /), & id_var_nutm_soil(l) ) CALL handle_error( "define variable N_UTM soil" ) status_nc = NF90_DEF_VAR( nc_id(l), 'depth', NF90_DOUBLE, & (/ id_position_soil(l) /), & id_var_depth(l) ) CALL handle_error( "define variable depth" ) ENDIF ! !-- Define the measured quantities DO n = 1, nvar(l) IF ( soil(l) .AND. & ANY( TRIM( variables(n,l) ) == soil_quantities ) ) THEN status_nc = NF90_DEF_VAR( nc_id(l), TRIM( variables(n,l) ), & NF90_DOUBLE, & (/ id_time(l), id_position_soil(l) /), & id_var(n,l) ) CALL handle_error( "define variable " // TRIM( variables(n,l) ) ) ELSE status_nc = NF90_DEF_VAR( nc_id(l), TRIM( variables(n,l) ), & NF90_DOUBLE, & (/ id_time(l), id_position(l) /), & id_var(n,l) ) CALL handle_error( "define variable " // TRIM( variables(n,l) ) ) ENDIF ENDDO #endif END SUBROUTINE netcdf_create_file !------------------------------------------------------------------------------! ! Description: ! ------------ !> This subroutine closes a NetCDF file. !------------------------------------------------------------------------------! SUBROUTINE netcdf_close_file IMPLICIT NONE #if defined( __netcdf ) status_nc = NF90_CLOSE( nc_id(l) ) CALL handle_error( "close file" ) #endif END SUBROUTINE netcdf_close_file !------------------------------------------------------------------------------! ! Description: ! ------------ !> This subroutine writes the spatial coordinates !------------------------------------------------------------------------------! SUBROUTINE netcdf_write_spatial_coordinates IMPLICIT NONE ! !-- Write coordinates #if defined( __netcdf ) status_nc = NF90_PUT_VAR( nc_id(l), id_var_eutm(l), e_utm, & start = (/ start_count_utm(l) /), & count = (/ ns(l) /) ) CALL handle_error( "write variable E_UTM" ) status_nc = NF90_PUT_VAR( nc_id(l), id_var_nutm(l), n_utm, & start = (/ start_count_utm(l) /), & count = (/ ns(l) /) ) CALL handle_error( "write variable N_UTM" ) status_nc = NF90_PUT_VAR( nc_id(l), id_var_hao(l), z_ag, & start = (/ start_count_utm(l) /), & count = (/ ns(l) /) ) CALL handle_error( "write variable height_above_origin" ) IF ( soil(l) ) THEN status_nc = NF90_PUT_VAR( nc_id(l), id_var_eutm_soil(l), e_utm_soil, & start = (/ start_count_utm_soil(l) /), & count = (/ ns_soil(l) /) ) CALL handle_error( "write variable E_UTM soil" ) status_nc = NF90_PUT_VAR( nc_id(l), id_var_nutm_soil(l), n_utm_soil, & start = (/ start_count_utm_soil(l) /), & count = (/ ns_soil(l) /) ) CALL handle_error( "write variable N_UTM soil" ) status_nc = NF90_PUT_VAR( nc_id(l), id_var_depth(l), depth, & start = (/ start_count_utm_soil(l) /), & count = (/ ns_soil(l) /) ) CALL handle_error( "write variable depth" ) ENDIF ! !-- End of NetCDF file definition status_nc = NF90_ENDDEF( nc_id(l) ) #endif END SUBROUTINE netcdf_write_spatial_coordinates !------------------------------------------------------------------------------! ! Description: ! ------------ !> This subroutine writes another time step to the unlimited time dimension. !------------------------------------------------------------------------------! SUBROUTINE netcdf_write_time_coordinate IMPLICIT NONE #if defined( __netcdf ) status_nc = NF90_PUT_VAR( nc_id(l), id_var_time(l), (/ output_time /), & start = (/ start_count_time(l) /), & count = (/ 1 /) ) CALL handle_error( "write variable time" ) #endif END SUBROUTINE netcdf_write_time_coordinate !------------------------------------------------------------------------------! ! Description: ! ------------ !> This subroutine writes the sampled variable to the NetCDF file. !------------------------------------------------------------------------------! SUBROUTINE netcdf_data_output IMPLICIT NONE IF ( soil(l) .AND. & ANY( TRIM( variables(n,l) ) == soil_quantities ) ) THEN status_nc = NF90_PUT_VAR( nc_id(l), id_var(n,l), (/ var_soil /), & start = (/ start_count_time(l), & start_count_utm_soil(l) /), & count = (/ 1, ns_soil(l) /) ) CALL handle_error( "write variable " // TRIM( variables(n,l) ) ) ELSE status_nc = NF90_PUT_VAR( nc_id(l), id_var(n,l), (/ var /), & start = (/ start_count_time(l), & start_count_utm(l) /), & count = (/ 1, ns(l) /) ) CALL handle_error( "write variable " // TRIM( variables(n,l) ) ) ENDIF END SUBROUTINE netcdf_data_output !------------------------------------------------------------------------------! ! Description: ! ------------ !> NetCDF error handling. !------------------------------------------------------------------------------! SUBROUTINE handle_error( action ) IMPLICIT NONE CHARACTER(LEN=*) :: action !< string indicating the current file action #if defined( __netcdf ) IF ( status_nc /= NF90_NOERR ) THEN PRINT*, TRIM( NF90_STRERROR( status_nc ) ) // ' -- ' // action STOP ENDIF #endif END SUBROUTINE handle_error END PROGRAM combine_virtual_measurements