source: palm/trunk/SOURCE/virtual_measurement_mod.f90 @ 3721

Last change on this file since 3721 was 3718, checked in by suehring, 6 years ago

Adjust variable name connections between UC2 and chemistry variables

  • Property svn:executable set to *
  • Property svn:keywords set to Id
File size: 73.5 KB
RevLine 
[3471]1!> @virtual_measurement_mod.f90
[3434]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 2017 Leibniz Universitaet Hannover
18!------------------------------------------------------------------------------!
19!
20! Current revisions:
21! -----------------
[3705]22!
23!
24! Former revisions:
25! -----------------
26! $Id: virtual_measurement_mod.f90 3718 2019-02-06 11:08:28Z knoop $
[3718]27! Adjust variable name connections between UC2 and chemistry variables
28!
29! 3717 2019-02-05 17:21:16Z suehring
[3717]30! Additional check + error numbers adjusted
31!
32! 3706 2019-01-29 20:02:26Z suehring
[3706]33! unused variables removed
34!
35! 3705 2019-01-29 19:56:39Z suehring
[3704]36! - initialization revised
37! - binary data output
38! - list of allowed variables extended
[3434]39!
[3705]40! 3704 2019-01-29 19:51:41Z suehring
[3522]41! Sampling of variables
42!
43! 3494 2018-11-06 14:51:27Z suehring
[3494]44! Bugfixing
45!
46! 3473 2018-10-30 20:50:15Z suehring
[3473]47! Initial revision
[3434]48!
49! Authors:
50! --------
[3522]51! @author Matthias Suehring
[3434]52!
53! Description:
54! ------------
[3471]55!> The module acts as an interface between 'real-world' observations and
56!> model simulations. Virtual measurements will be taken in the model at the
[3704]57!> coordinates representative for the 'real-world' observation coordinates.
[3471]58!> More precisely, coordinates and measured quanties will be read from a
59!> NetCDF file which contains all required information. In the model,
60!> the same quantities (as long as all the required components are switched-on)
61!> will be sampled at the respective positions and output into an extra file,
62!> which allows for straight-forward comparison of model results with
63!> observations.
[3522]64!>
65!> @todo list_of_allowed variables needs careful checking
66!> @todo Check if sign of surface fluxes for heat, radiation, etc., follows
67!>       the (UC)2 standard
68!> @note Fluxes are not processed
[3434]69!------------------------------------------------------------------------------!
[3471]70 MODULE virtual_measurement_mod
[3434]71
72    USE arrays_3d,                                                             &
73        ONLY:  q, pt, u, v, w, zu, zw
74
[3522]75    USE chem_modules,                                                          &
76        ONLY:  nspec
77
78    USE chemistry_model_mod,                                                   &
79        ONLY:  chem_species
80       
[3434]81    USE control_parameters,                                                    &
[3704]82        ONLY:  air_chemistry, dz, humidity, io_blocks, io_group, neutral,      &
83               message_string, time_since_reference_point, virtual_measurement
[3434]84
85    USE cpulog,                                                                &
86        ONLY:  cpu_log, log_point
87       
88    USE grid_variables,                                                        &
89        ONLY:  dx, dy
90
91    USE indices,                                                               &
[3704]92        ONLY:  nzb, nzt, nxl, nxr, nys, nyn, nx, ny, wall_flags_0
[3434]93
94    USE kinds
[3704]95   
96    USE netcdf_data_input_mod,                                                 &
97        ONLY:  init_model
98       
99    USE pegrid
100   
101    USE surface_mod,                                                           &
102        ONLY:  surf_lsm_h, surf_usm_h
103       
104    USE land_surface_model_mod,                                                &
105        ONLY:  nzb_soil, nzs, nzt_soil, zs, t_soil_h, m_soil_h 
106       
107    USE radiation_model_mod
108       
109    USE urban_surface_mod,                                                     &
110        ONLY:  nzb_wall, nzt_wall, t_wall_h 
[3434]111
112
113    IMPLICIT NONE
[3704]114   
115    TYPE virt_general
116       INTEGER(iwp) ::  id_vm     !< NetCDF file id for virtual measurements
117       INTEGER(iwp) ::  nvm = 0   !< number of virtual measurements
118    END TYPE virt_general
[3434]119
120    TYPE virt_mea
121   
[3704]122       CHARACTER(LEN=100)  ::  feature_type      !< type of the measurement
123       CHARACTER(LEN=100)  ::  filename_original !< name of the original file
124       CHARACTER(LEN=100)  ::  site              !< name of the measurement site
[3434]125   
126       CHARACTER(LEN=10), DIMENSION(:), ALLOCATABLE ::  measured_vars_name !< name of the measured variables
127   
[3704]128       INTEGER(iwp) ::  ns = 0          !< number of observation coordinates on subdomain, for atmospheric measurements
129       INTEGER(iwp) ::  ns_tot = 0      !< total number of observation coordinates, for atmospheric measurements
130       INTEGER(iwp) ::  ntraj           !< number of trajectories of a measurement
131       INTEGER(iwp) ::  nvar            !< number of measured variables (atmosphere + soil)
[3434]132       
[3704]133       INTEGER(iwp) ::  ns_soil = 0     !< number of observation coordinates on subdomain, for soil measurements
134       INTEGER(iwp) ::  ns_soil_tot = 0 !< total number of observation coordinates, for soil measurements
135       
[3434]136       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  dim_t !< number observations individual for each trajectory or station that are no _FillValues
137       
[3704]138       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  i       !< grid index for measurement position in x-direction
139       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  j       !< grid index for measurement position in y-direction
140       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  k       !< grid index for measurement position in k-direction
141       
142       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  i_soil  !< grid index for measurement position in x-direction
143       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  j_soil  !< grid index for measurement position in y-direction
144       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  k_soil  !< grid index for measurement position in k-direction
[3434]145           
146       LOGICAL ::  trajectory         = .FALSE. !< flag indicating that the observation is a mobile observation
147       LOGICAL ::  timseries          = .FALSE. !< flag indicating that the observation is a stationary point measurement
148       LOGICAL ::  timseries_profile  = .FALSE. !< flag indicating that the observation is a stationary profile measurement
[3704]149       LOGICAL ::  soil_sampling      = .FALSE. !< flag indicating that soil state variables were sampled
[3434]150       
[3704]151       REAL(wp) ::  fill_eutm          !< fill value for UTM coordinates in case of missing values
152       REAL(wp) ::  fill_nutm          !< fill value for UTM coordinates in case of missing values
153       REAL(wp) ::  fill_zag           !< fill value for heigth coordinates in case of missing values
154       REAL(wp) ::  fillout = -999.9   !< fill value for output in case a observation is taken from inside a building
155       REAL(wp) ::  origin_x_obs       !< origin of the observation in UTM coordiates in x-direction
156       REAL(wp) ::  origin_y_obs       !< origin of the observation in UTM coordiates in y-direction
157       
158       REAL(wp), DIMENSION(:), ALLOCATABLE   ::  z_ag           !< measurement height above ground level
159       REAL(wp), DIMENSION(:), ALLOCATABLE   ::  depth          !< measurement depth in soil
[3522]160             
[3704]161       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  measured_vars       !< measured variables
162       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  measured_vars_soil  !< measured variables
[3434]163       
164    END TYPE virt_mea
165
166    CHARACTER(LEN=5)  ::  char_eutm = "E_UTM"                      !< dimension name for UTM coordinate easting
167    CHARACTER(LEN=11) ::  char_feature = "featureType"             !< attribute name for feature type
[3704]168   
169    ! This need to generalized
170    CHARACTER(LEN=8)  ::  char_filename = "filename"               !< attribute name for filename
171    CHARACTER(LEN=11) ::  char_soil = "soil_sample"                !< attribute name for soil sampling indication
[3434]172    CHARACTER(LEN=10) ::  char_fillvalue = "_FillValue"            !< variable attribute name for _FillValue
173    CHARACTER(LEN=18) ::  char_mv = "measured_variables"           !< variable name for the array with the measured variable names
174    CHARACTER(LEN=5)  ::  char_nutm = "N_UTM"                      !< dimension name for UTM coordinate northing
175    CHARACTER(LEN=18) ::  char_numstations = "number_of_stations"  !< attribute name for number of stations
176    CHARACTER(LEN=8)  ::  char_origx = "origin_x"                  !< attribute name for station coordinate in x
177    CHARACTER(LEN=8)  ::  char_origy = "origin_y"                  !< attribute name for station coordinate in y
178    CHARACTER(LEN=4)  ::  char_site = "site"                       !< attribute name for site name
179    CHARACTER(LEN=19) ::  char_zag = "height_above_ground"         !< attribute name for height above ground variable
180    CHARACTER(LEN=10) ::  type_ts   = 'timeSeries'                 !< name of stationary point measurements
181    CHARACTER(LEN=10) ::  type_traj = 'trajectory'                 !< name of line measurements
182    CHARACTER(LEN=17) ::  type_tspr = 'timeSeriesProfile'          !< name of stationary profile measurements
[3704]183   
184    CHARACTER(LEN=6), DIMENSION(1:5) ::  soil_vars       = (/                  & !< list of soil variables
185                            't_soil',                                          &
186                            'm_soil',                                          &
187                            'lwc   ',                                          &
188                            'lwcs  ',                                          &
189                            'smp   '                       /)
190                           
191    CHARACTER(LEN=10), DIMENSION(0:1,1:8) ::  chem_vars = RESHAPE( (/          &
[3718]192                                              'mcpm1     ', 'PM1       ',      &
193                                              'mcpm2p5   ', 'PM2.5     ',      &
194                                              'mcpm25    ', 'PM25      ',      &
195                                              'mcpm10    ', 'PM10      ',      &
196                                              'mfno2     ', 'NO2       ',      &
197                                              'mfno      ', 'NO        ',      &
198                                              'tro3      ', 'O3        ',      &
199                                              'mfco      ', 'CO        '       &
[3704]200                                                                   /), (/ 2, 8 /) )
[3522]201!
202!-- MS: List requires careful revision!
[3704]203    CHARACTER(LEN=10), DIMENSION(1:54), PARAMETER ::  list_allowed_variables = & !< variables that can be sampled in PALM
[3471]204       (/ 'hfls      ',  & ! surface latent heat flux (W/m2)
205          'hfss      ',  & ! surface sensible heat flux (W/m2)
206          'hur       ',  & ! relative humidity (-)
207          'hus       ',  & ! specific humidity (g/kg)
208          'haa       ',  & ! absolute atmospheric humidity (kg/m3)
209          'mcpm1     ',  & ! mass concentration of PM1 (kg/m3)
210          'mcpm2p5   ',  & ! mass concentration of PM2.5 (kg/m3)
211          'mcpm10    ',  & ! mass concentration of PM10 (kg/m3)
212          'mcco      ',  & ! mass concentration of CO (kg/m3)
213          'mcco2     ',  & ! mass concentration of CO2 (kg/m3)
214          'mcbcda    ',  & ! mass concentration of black carbon paritcles (kg/m3)
215          'ncaa      ',  & ! number concentation of particles (1/m3)
[3522]216          'mfco      ',  & ! mole fraction of CO (mol/mol)
[3471]217          'mfco2     ',  & ! mole fraction of CO2 (mol/mol)
218          'mfch4     ',  & ! mole fraction of methane (mol/mol)
219          'mfnh3     ',  & ! mole fraction of amonia (mol/mol)
220          'mfno      ',  & ! mole fraction of nitrogen monoxide (mol/mol)
221          'mfno2     ',  & ! mole fraction of nitrogen dioxide (mol/mol)
222          'mfso2     ',  & ! mole fraction of sulfur dioxide (mol/mol)
223          'mfh20     ',  & ! mole fraction of water (mol/mol)
224          'plev      ',  & ! ? air pressure - hydrostaic + perturbation?
225          'rlds      ',  & ! surface downward longwave flux  (W/m2)
226          'rlus      ',  & ! surface upward longwave flux (W/m2)
227          'rsds      ',  & ! surface downward shortwave flux (W/m2)
228          'rsus      ',  & ! surface upward shortwave flux (W/m2)
229          'ta        ',  & ! air temperature (degree C)
230          't_va      ',  & ! virtual accoustic temperature (K)
231          'theta     ',  & ! potential temperature (K)
232          'tro3      ',  & ! mole fraction of ozone air (mol/mol)
233          'ts        ',  & ! scaling parameter of temperature (K)
234          'wspeed    ',  & ! ? wind speed - horizontal?
235          'wdir      ',  & ! wind direction
236          'us        ',  & ! friction velocity
237          'msoil     ',  & ! ? soil moisture - which depth? 
238          'tsoil     ',  & ! ? soil temperature - which depth?                                                               
239          'u         ',  & ! u-component
[3704]240          'utheta    ',  & ! total eastward kinematic heat flux
[3471]241          'ua        ',  & ! eastward wind (is there any difference to u?)
242          'v         ',  & ! v-component
[3704]243          'vtheta    ',  & ! total northward kinematic heat flux
[3471]244          'va        ',  & ! northward wind (is there any difference to v?)
245          'w         ',  & ! w-component
[3704]246          'wtheta    ',  & ! total vertical kinematic heat flux
[3471]247          'rld       ',  & ! downward longwave radiative flux (W/m2)
248          'rlu       ',  & ! upnward longwave radiative flux (W/m2)
249          'rsd       ',  & ! downward shortwave radiative flux (W/m2)
250          'rsu       ',  & ! upward shortwave radiative flux (W/m2)
251          'rsddif    ',  & ! downward shortwave diffuse radiative flux (W/m2)
[3704]252          'rnds      ',  & ! surface net downward radiative flux (W/m2)
253          't_soil    ',  &
254          'm_soil    ',  &
255          'lwc       ',  &
256          'lwcs      ',  &
257          'smp       '   &
[3471]258       /)
[3704]259                                                           
[3434]260   
[3704]261    LOGICAL ::  global_attribute = .TRUE.         !< flag indicating a global attribute
262    LOGICAL ::  init = .TRUE.                     !< flag indicating initialization of data output
[3434]263    LOGICAL ::  use_virtual_measurement = .FALSE. !< Namelist parameter
264   
265    REAL(wp) ::  vm_time_start = 0.0              !< time after virtual measurements should start
266
[3704]267    TYPE( virt_general )                        ::  vmea_general !< data structure which encompass general variables
[3434]268    TYPE( virt_mea ), DIMENSION(:), ALLOCATABLE ::  vmea !< virtual measurement data structure
269   
270    INTERFACE vm_check_parameters
271       MODULE PROCEDURE vm_check_parameters
272    END INTERFACE vm_check_parameters
273   
[3704]274    INTERFACE vm_data_output
275       MODULE PROCEDURE vm_data_output
276    END INTERFACE vm_data_output
277   
[3434]278    INTERFACE vm_init
279       MODULE PROCEDURE vm_init
280    END INTERFACE vm_init
281   
[3704]282    INTERFACE vm_last_actions
283       MODULE PROCEDURE vm_last_actions
284    END INTERFACE vm_last_actions
285   
[3434]286    INTERFACE vm_parin
287       MODULE PROCEDURE vm_parin
288    END INTERFACE vm_parin
289   
290    INTERFACE vm_sampling
291       MODULE PROCEDURE vm_sampling
292    END INTERFACE vm_sampling
293
294    SAVE
295
296    PRIVATE
297
298!
299!-- Public interfaces
[3704]300    PUBLIC  vm_check_parameters, vm_data_output, vm_init, vm_last_actions,     &
301            vm_parin, vm_sampling
[3434]302
303!
304!-- Public variables
[3704]305    PUBLIC  vmea, vmea_general, vm_time_start
[3434]306
307 CONTAINS
308
309
310!------------------------------------------------------------------------------!
311! Description:
312! ------------
[3471]313!> Check parameters for virtual measurement module
[3434]314!------------------------------------------------------------------------------!
315 SUBROUTINE vm_check_parameters
316
317    USE control_parameters,                                                    &
318        ONLY:  message_string, virtual_measurement
319 
320    USE netcdf_data_input_mod,                                                 &
[3717]321        ONLY:  input_pids_static, input_pids_vm
[3434]322       
323    IMPLICIT NONE
[3717]324
[3434]325!
[3717]326!-- Virtual measurements require a setup file.
327    IF ( virtual_measurement  .AND.  .NOT. input_pids_vm )  THEN
328       message_string = 'If virtual measurements are taken, a setup input ' // &
329                        'file for the site locations is mandatory.'
330       CALL message( 'vm_check_parameters', 'PA0533', 1, 2, 0, 6, 0 )
331    ENDIF   
332!
[3434]333!-- In case virtual measurements are taken, a static input file is required.
334!-- This is because UTM coordinates for the PALM domain origin are required
335!-- for correct mapping of the measurements.
336!-- ToDo: Revise this later and remove this requirement.
337    IF ( virtual_measurement  .AND.  .NOT. input_pids_static )  THEN
[3704]338       message_string = 'If virtual measurements are taken, a static input ' //&
[3434]339                        'file is mandatory.'
[3717]340       CALL message( 'vm_check_parameters', 'PA0534', 1, 2, 0, 6, 0 )
[3434]341    ENDIF
342 
343 END SUBROUTINE vm_check_parameters
344 
345!------------------------------------------------------------------------------!
346! Description:
347! ------------
[3471]348!> Read namelist for the virtual measurement module
[3434]349!------------------------------------------------------------------------------!
350 SUBROUTINE vm_parin
351 
352    CHARACTER (LEN=80) ::  line   !< dummy string that contains the current line of the parameter file
353 
354    NAMELIST /virtual_measurement_parameters/  use_virtual_measurement,        &
355                                               vm_time_start
356
357    line = ' '
358
359!
360!-- Try to find stg package
361    REWIND ( 11 )
362    line = ' '
363    DO WHILE ( INDEX( line, '&virtual_measurement_parameters' ) == 0 )
364       READ ( 11, '(A)', END=20 )  line
365    ENDDO
366    BACKSPACE ( 11 )
367
368!
369!-- Read namelist
370    READ ( 11, virtual_measurement_parameters, ERR = 10, END = 20 )
371
372!
[3471]373!-- Set flag that indicates that the virtual measurement module is switched on
[3434]374    IF ( use_virtual_measurement )  virtual_measurement = .TRUE.
375   
376    GOTO 20
377
378 10 BACKSPACE( 11 )
379    READ( 11 , '(A)') line
380    CALL parin_fail_message( 'virtual_measurement_parameters', line )
381
382 20 CONTINUE
383 
384 END SUBROUTINE vm_parin
385
386
387!------------------------------------------------------------------------------!
388! Description:
389! ------------
390!> Initialize virtual measurements: read coordiante arrays and measured
391!> variables, set indicies indicating the measurement points, read further
392!> attributes, etc..
393!------------------------------------------------------------------------------!
394 SUBROUTINE vm_init
395
396    USE arrays_3d,                                                             &
397        ONLY:  zu, zw
398       
399    USE grid_variables,                                                        &
400        ONLY:  ddx, ddy, dx, dy
401       
402    USE indices,                                                               &
403        ONLY:  nxl, nxr, nyn, nys
404 
405    USE netcdf_data_input_mod,                                                 &
[3704]406        ONLY:  init_model, input_file_vm,                                      &
407               netcdf_data_input_get_dimension_length,                         &
[3434]408               netcdf_data_input_att, netcdf_data_input_var
409               
410    USE surface_mod,                                                           &
411        ONLY:  get_topography_top_index_ji
412       
413    IMPLICIT NONE
414   
415    CHARACTER(LEN=5)    ::  dum                !< dummy string indicate station id
[3704]416    CHARACTER(LEN=5)    ::  dummy_read                !< dummy string indicate station id
[3434]417    CHARACTER(LEN=10), DIMENSION(50) ::  measured_variables_file = '' !< array with all measured variables read from NetCDF
[3522]418    CHARACTER(LEN=10), DIMENSION(50) ::  measured_variables      = '' !< dummy array with all measured variables that are allowed   
[3434]419   
420    INTEGER(iwp) ::  dim_ntime !< dimension size of time coordinate
[3704]421    INTEGER(iwp) ::  i         !< grid index of virtual observation point in x-direction
[3434]422    INTEGER(iwp) ::  is        !< grid index of real observation point of the respective station in x-direction
[3704]423    INTEGER(iwp) ::  j         !< grid index of observation point in x-direction
[3434]424    INTEGER(iwp) ::  js        !< grid index of real observation point of the respective station in y-direction
[3704]425    INTEGER(iwp) ::  k         !< grid index of observation point in x-direction
[3522]426    INTEGER(iwp) ::  kl        !< lower vertical index of surrounding grid points of an observation coordinate
[3434]427    INTEGER(iwp) ::  ks        !< grid index of real observation point of the respective station in z-direction
428    INTEGER(iwp) ::  ksurf     !< topography top index
[3522]429    INTEGER(iwp) ::  ku        !< upper vertical index of surrounding grid points of an observation coordinate
[3434]430    INTEGER(iwp) ::  l         !< running index over all stations
431    INTEGER(iwp) ::  len_char  !< character length of single measured variables without Null character
432    INTEGER(iwp) ::  ll        !< running index over all measured variables in file
433    INTEGER(iwp) ::  lll       !< running index over all allowed variables
434    INTEGER(iwp) ::  n         !< running index over trajectory coordinates
435    INTEGER(iwp) ::  ns        !< counter variable for number of observation points on subdomain
436    INTEGER(iwp) ::  t         !< running index over number of trajectories
[3704]437    INTEGER(iwp) ::  m
[3434]438   
[3704]439    INTEGER(KIND=1)::  soil_dum
440   
441    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  ns_all !< dummy array used to sum-up the number of observation coordinates
442   
[3522]443    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE ::  meas_flag !< mask array indicating measurement positions
444   
445    LOGICAL ::  chem_include !< flag indicating that chemical species is considered in modelled mechanism
446    LOGICAL ::  on_pe        !< flag indicating that the respective measurement coordinate is on subdomain
447   
[3434]448    REAL(wp)     ::  fill_eutm !< _FillValue for coordinate array E_UTM
449    REAL(wp)     ::  fill_nutm !< _FillValue for coordinate array N_UTM
450    REAL(wp)     ::  fill_zag  !< _FillValue for height coordinate
451   
[3437]452    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  e_utm !< easting UTM coordinate, temporary variable
453    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  n_utm !< northing UTM coordinate, temporary variable,
454    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  z_ag  !< height coordinate relative to origin_z, temporary variable
[3434]455!
[3704]456!-- Obtain number of sites. Also, pass the 'open' string, in order to initially
457!-- open the measurement driver.
458    CALL netcdf_data_input_att( vmea_general%nvm, char_numstations,            &
459                                vmea_general%id_vm, input_file_vm,             &
[3434]460                                global_attribute, 'open', '' )
[3522]461                               
[3434]462!
[3704]463!-- Allocate data structure which encompass all required information, such as
464!-- grid points indicies, absolute UTM coordinates, the measured quantities,
465!-- etc. .
466    ALLOCATE( vmea(1:vmea_general%nvm) )
[3434]467!
[3704]468!-- Allocate flag array. This dummy array is used to identify grid points
469!-- where virtual measurements should be taken. Please note, at least one
470!-- ghost point is required, in order to include also the surrounding
471!-- grid points of the original coordinate. 
[3522]472    ALLOCATE( meas_flag(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
473    meas_flag = 0
474!
[3704]475!-- Loop over all sites.
476    DO  l = 1, vmea_general%nvm
[3434]477!
[3704]478!--    Determine suffix which contains the ID, ordered according to the number
479!--    of measurements.
[3434]480       IF( l < 10 )  THEN
481          WRITE( dum, '(I1)')  l
482       ELSEIF( l < 100 )  THEN
483          WRITE( dum, '(I2)')  l
484       ELSEIF( l < 1000 )  THEN
485          WRITE( dum, '(I3)')  l
486       ELSEIF( l < 10000 )  THEN
487          WRITE( dum, '(I4)')  l
488       ELSEIF( l < 100000 )  THEN
489          WRITE( dum, '(I5)')  l
490       ENDIF
[3704]491!
492!--    Read site coordinates (UTM).
493       CALL netcdf_data_input_att( vmea(l)%origin_x_obs, char_origx //         &
494                                   TRIM( dum ), vmea_general%id_vm, '',        &
495                                   global_attribute, '', '' )
496       CALL netcdf_data_input_att( vmea(l)%origin_y_obs, char_origy //         &
497                                   TRIM( dum ), vmea_general%id_vm, '',        &
498                                   global_attribute, '', '' )
499!
500!--    Read site name                 
501       CALL netcdf_data_input_att( vmea(l)%site, char_site // TRIM( dum ),     &
502                                   vmea_general%id_vm, '', global_attribute,   &
[3434]503                                   '', '' )
[3704]504!
505!--    Read type of the measurement (trajectory, profile, timeseries).
506       CALL netcdf_data_input_att( vmea(l)%feature_type, char_feature //       &
507                                   TRIM( dum ), vmea_general%id_vm, '',        &
508                                   global_attribute, '', '' )
509!
510!--    Read the name of the original file where observational data is stored.
511       CALL netcdf_data_input_att( vmea(l)%filename_original, char_filename // &
512                                   TRIM( dum ), vmea_general%id_vm, '',        &
513                                   global_attribute, '', '' )
514!
515!--    Read a flag which indicates that also soil quantities are take at the
516!--    respective site (is part of the virtual measurement driver). 
517       CALL netcdf_data_input_att( soil_dum, char_soil // TRIM( dum ),         &
518                                   vmea_general%id_vm, '', global_attribute,   &
[3434]519                                   '', '' )
520!
[3704]521!--    Set flag for soil-sampling.
522       IF ( soil_dum == 1 )  vmea(l)%soil_sampling = .TRUE.
523!
[3434]524!---   Set logicals depending on the type of the measurement
525       IF ( INDEX( vmea(l)%feature_type, type_tspr     ) /= 0 )  THEN
526          vmea(l)%timseries_profile = .TRUE.
527       ELSEIF ( INDEX( vmea(l)%feature_type, type_ts   ) /= 0 )  THEN
528          vmea(l)%timseries         = .TRUE.
529       ELSEIF ( INDEX( vmea(l)%feature_type, type_traj ) /= 0 )  THEN
530          vmea(l)%trajectory        = .TRUE.
[3704]531!
532!--   Give error message in case the type matches non of the pre-defined types.
[3434]533       ELSE
534          message_string = 'Attribue featureType = ' //                        &
535                           TRIM( vmea(l)%feature_type ) //                     &
536                           ' is not allowed.' 
[3717]537          CALL message( 'vm_init', 'PA0535', 1, 2, 0, 6, 0 )
[3434]538       ENDIF
539!
[3704]540!--    Read string with all measured variables at this site
[3434]541       measured_variables_file = ''
542       CALL netcdf_data_input_var( measured_variables_file,                    &
[3704]543                                   char_mv // TRIM( dum ), vmea_general%id_vm )
[3434]544!
[3704]545!--    Count the number of measured variables. Only count variables that match
546!--    with the allowed variables.
547!--    Please note, for some NetCDF interal reasons characters end with a NULL,
548!--    i.e. also empty characters contain a NULL. Therefore, check the strings
549!--    for a NULL to get the correct character length in order to compare
550!--    them with the list of allowed variables.
551       vmea(l)%nvar   = 0
[3434]552       DO ll = 1, SIZE( measured_variables_file )
553          IF ( measured_variables_file(ll)(1:1) /= CHAR(0)  .AND.              &
554               measured_variables_file(ll)(1:1) /= ' ')  THEN
555!
556!--          Obtain character length of the character
557             len_char = 1
558             DO WHILE ( measured_variables_file(ll)(len_char:len_char) /= CHAR(0)&
559                 .AND.  measured_variables_file(ll)(len_char:len_char) /= ' ' )
560                len_char = len_char + 1
561             ENDDO
562             len_char = len_char - 1
563!
564!--          Now, compare the measured variable with the list of allowed
565!--          variables.
566             DO  lll= 1, SIZE( list_allowed_variables )
567                IF ( measured_variables_file(ll)(1:len_char) ==                &
568                     TRIM( list_allowed_variables(lll) ) )  THEN
569                   vmea(l)%nvar = vmea(l)%nvar + 1
570                   measured_variables(vmea(l)%nvar) =                          &
571                                       measured_variables_file(ll)(1:len_char)
572                ENDIF
573             ENDDO
574          ENDIF
575       ENDDO
576!
[3704]577!--    Allocate array for the measured variables names for the respective site.
[3434]578       ALLOCATE( vmea(l)%measured_vars_name(1:vmea(l)%nvar) )
579
580       DO  ll = 1, vmea(l)%nvar
581          vmea(l)%measured_vars_name(ll) = TRIM( measured_variables(ll) )
582       ENDDO
583!
[3522]584!--    In case of chemistry, check if species is considered in the modelled
585!--    chemistry mechanism.
[3704]586!        IF ( air_chemistry )  THEN
587!           DO  ll = 1, vmea(l)%nvar
588!              chem_include = .FALSE.
589!              DO  n = 1, nspec
590!                 IF ( TRIM( vmea(l)%measured_vars_name(ll) ) ==                 &
591!                      TRIM( chem_species(n)%name ) )  chem_include = .TRUE.
592!              ENDDO
593! !
594! !--  Revise this. It should only check for chemistry variables and not for all!
595!              IF ( .NOT. chem_include )  THEN
596!                 message_string = TRIM( vmea(l)%measured_vars_name(ll) ) //     &
597!                                  ' is not considered in the modelled '  //     &
598!                                  'chemistry mechanism'
599!                 CALL message( 'vm_init', 'PA0000', 0, 0, 0, 6, 0 )
600!              ENDIF
601!           ENDDO
602!        ENDIF
[3522]603!
[3704]604!--    Read the UTM coordinates for the actual site. Based on the coordinates,
605!--    define the grid-index space on each subdomain where virtual measurements
606!--    should be taken. Note, the entire coordinate arrays will not be stored
607!--    as this would exceed memory requirements, particularly for trajectory
608!--    measurements.
[3434]609       IF ( vmea(l)%nvar > 0 )  THEN
610!
611!--       For stationary measurements UTM coordinates are just one value and
612!--       its dimension is "station", while for mobile measurements UTM
[3704]613!--       coordinates are arrays depending on the number of trajectories and
614!--       time, according to (UC)2 standard. First, inquire dimension length
615!--       of the UTM coordinates.
[3434]616          IF ( vmea(l)%trajectory )  THEN
617!
618!--          For non-stationary measurements read the number of trajectories
[3704]619!--          and the number of time coordinates.
620             CALL netcdf_data_input_get_dimension_length( vmea_general%id_vm, &
[3434]621                                                          vmea(l)%ntraj,      &
622                                                          "traj" //           &
623                                                          TRIM( dum ) )
[3704]624             CALL netcdf_data_input_get_dimension_length( vmea_general%id_vm, &
625                                                          dim_ntime,          &
[3434]626                                                          "ntime" //          &
627                                                          TRIM( dum ) )
628!
[3704]629!--       For stationary measurements the dimension for UTM and time
630!--       coordinates is 1.
[3434]631          ELSE
632             vmea(l)%ntraj  = 1
633             dim_ntime = 1
634          ENDIF
635!
636!-        Allocate array which defines individual time frame for each
[3704]637!--       trajectory or station.
[3434]638          ALLOCATE( vmea(l)%dim_t(1:vmea(l)%ntraj) )
639!
640!--       Allocate temporary arrays for UTM and height coordinates. Note,
641!--       on file UTM coordinates might be 1D or 2D variables
[3437]642          ALLOCATE( e_utm(1:vmea(l)%ntraj,1:dim_ntime) )
643          ALLOCATE( n_utm(1:vmea(l)%ntraj,1:dim_ntime) )
644          ALLOCATE( z_ag(1:vmea(l)%ntraj,1:dim_ntime)  )
[3434]645!
[3704]646!--       Read _FillValue attributes of the coordinate dimensions.
[3434]647          CALL netcdf_data_input_att( fill_eutm, char_fillvalue,               &
[3704]648                                      vmea_general%id_vm, '',                  &
649                                      .NOT. global_attribute, '',              &
[3434]650                                      char_eutm // TRIM( dum ) )
651          CALL netcdf_data_input_att( fill_nutm, char_fillvalue,               &
[3704]652                                      vmea_general%id_vm, '',                  &
653                                      .NOT. global_attribute, '',              &
[3434]654                                      char_nutm // TRIM( dum ) )
655          CALL netcdf_data_input_att( fill_zag, char_fillvalue,                &
[3704]656                                      vmea_general%id_vm, '',                  &
657                                      .NOT. global_attribute, '',              &
[3434]658                                      char_zag  // TRIM( dum ) )
659!
660!--       Read UTM and height coordinates coordinates for all trajectories and
661!--       times.
[3437]662          IF ( vmea(l)%trajectory )  THEN
[3704]663             CALL netcdf_data_input_var( e_utm, char_eutm // TRIM( dum ),      &
664                                         vmea_general%id_vm,                   &
[3437]665                                         0, dim_ntime-1, 0, vmea(l)%ntraj-1 )
[3704]666             CALL netcdf_data_input_var( n_utm, char_nutm // TRIM( dum ),      &
667                                         vmea_general%id_vm,                   &
[3437]668                                         0, dim_ntime-1, 0, vmea(l)%ntraj-1 )
[3704]669             CALL netcdf_data_input_var( z_ag, char_zag // TRIM( dum ),        &
670                                         vmea_general%id_vm,                   &
[3437]671                                         0, dim_ntime-1, 0, vmea(l)%ntraj-1 )
672          ELSE
[3704]673             CALL netcdf_data_input_var( e_utm(1,:), char_eutm // TRIM( dum ), &
674                                         vmea_general%id_vm )
675             CALL netcdf_data_input_var( n_utm(1,:), char_nutm // TRIM( dum ), &
676                                         vmea_general%id_vm )
677             CALL netcdf_data_input_var( z_ag(1,:),  char_zag  // TRIM( dum ), &
678                                         vmea_general%id_vm )
679          ENDIF         
[3434]680!
681!--       Based on UTM coordinates, check if the measurement station or parts
682!--       of the trajectory is on subdomain. This case, setup grid index space
683!--       sample these quantities.
[3522]684          meas_flag = 0
[3434]685          DO  t = 1, vmea(l)%ntraj
[3704]686!             
687!--          First, compute relative x- and y-coordinates with respect to the
688!--          lower-left origin of the model domain, which is the difference
689!--          betwen UTM coordinates. Note, if the origin is not correct, the
690!--          virtual sites will be misplaced.
691             e_utm(t,1:dim_ntime) = e_utm(t,1:dim_ntime) - init_model%origin_x
692             n_utm(t,1:dim_ntime) = n_utm(t,1:dim_ntime) - init_model%origin_y
[3434]693!
694!--          Determine the individual time coordinate length for each station and
695!--          trajectory. This is required as several stations and trajectories
696!--          are merged into one file but they do not have the same number of
697!--          points in time, hence, missing values may occur and cannot be
[3704]698!--          processed further. This is actually a work-around for the specific
699!--          (UC)2 dataset, but it won't harm in anyway.
[3434]700             vmea(l)%dim_t(t) = 0
701             DO  n = 1, dim_ntime
[3437]702                IF ( e_utm(t,n) /= fill_eutm  .AND.                            &
703                     n_utm(t,n) /= fill_nutm  .AND.                            &
704                     z_ag(t,n)  /= fill_zag )  vmea(l)%dim_t(t) = n
[3434]705             ENDDO
706!
707!--          Compute grid indices relative to origin and check if these are
708!--          on the subdomain. Note, virtual measurements will be taken also
709!--          at grid points surrounding the station, hence, check also for
710!--          these grid points.
[3437]711             DO  n = 1, vmea(l)%dim_t(t)
712                is = INT( ( e_utm(t,n) + 0.5_wp * dx ) * ddx, KIND = iwp )
713                js = INT( ( n_utm(t,n) + 0.5_wp * dy ) * ddy, KIND = iwp )             
[3434]714!
715!--             Is the observation point on subdomain?
716                on_pe = ( is >= nxl  .AND.  is <= nxr  .AND.                   &
717                          js >= nys  .AND.  js <= nyn )
718!
[3522]719!--             Check if observation coordinate is on subdomain
[3434]720                IF ( on_pe )  THEN
[3522]721!
722!--                Determine vertical index which correspond to the observation
723!--                height.
[3434]724                   ksurf = get_topography_top_index_ji( js, is, 's' )
[3437]725                   ks = MINLOC( ABS( zu - zw(ksurf) - z_ag(t,n) ), DIM = 1 ) - 1
[3434]726!
[3522]727!--                Set mask array at the observation coordinates. Also, flag the
728!--                surrounding coordinate points, but first check whether the
729!--                surrounding coordinate points are on the subdomain.
[3704]730                   kl = MERGE( ks-1, ks, ks-1 >= nzb  .AND. ks-1 >= ksurf )
731                   ku = MERGE( ks+1, ks, ks+1 < nzt+1 )
[3522]732                 
[3704]733                   DO  i = is-1, is+1
734                      DO  j = js-1, js+1
735                         DO  k = kl, ku
736                            meas_flag(k,j,i) = MERGE(                          &
737                                             IBSET( meas_flag(k,j,i), 0 ),     &
738                                             0,                                &
739                                             BTEST( wall_flags_0(k,j,i), 0 )   &
740                                                    )
741                         ENDDO
742                      ENDDO
743                   ENDDO
[3434]744                ENDIF
745             ENDDO
746             
747          ENDDO
748!
[3704]749!--       Based on the flag array count the number of of sampling coordinates.
750!--       Please note, sampling coordinates in atmosphere and soil may be
751!--       different, as within the soil all levels will be measured.           
752!--       Hence, count individually. Start with atmoshere.
[3522]753          ns = 0
[3704]754          DO  i = nxl-1, nxr+1
755             DO  j = nys-1, nyn+1
756                DO  k = nzb, nzt+1
757                   ns = ns + MERGE( 1, 0, BTEST( meas_flag(k,j,i), 0 ) )
[3522]758                ENDDO
759             ENDDO
760          ENDDO
[3704]761         
[3522]762!
[3434]763!--       Store number of observation points on subdomain and allocate index
[3704]764!--       arrays as well as array containing height information.
[3434]765          vmea(l)%ns = ns
766         
767          ALLOCATE( vmea(l)%i(1:vmea(l)%ns) )
768          ALLOCATE( vmea(l)%j(1:vmea(l)%ns) )
769          ALLOCATE( vmea(l)%k(1:vmea(l)%ns) )
[3704]770          ALLOCATE( vmea(l)%z_ag(1:vmea(l)%ns) )         
[3434]771!
[3522]772!--       Based on the flag array store the grid indices which correspond to
773!--       the observation coordinates.
[3704]774          ns = 0
775          DO  i = nxl-1, nxr+1
776             DO  j = nys-1, nyn+1
777                DO  k = nzb, nzt+1
778                   IF ( BTEST( meas_flag(k,j,i), 0 ) )  THEN
[3522]779                      ns = ns + 1
[3704]780                      vmea(l)%i(ns) = i
781                      vmea(l)%j(ns) = j
782                      vmea(l)%k(ns) = k
783                      vmea(l)%z_ag(ns)  = zu(k) -                              &
784                                   zw(get_topography_top_index_ji( j, i, 's' ))
[3522]785                   ENDIF
786                ENDDO
[3434]787             ENDDO
788          ENDDO
789!
[3704]790!--       Same for the soil. Based on the flag array, count the number of
791!--       sampling coordinates in soil. Sample at all soil levels in this case.
792          IF ( vmea(l)%soil_sampling )  THEN
793             DO  i = nxl, nxr
794                DO  j = nys, nyn
795                   IF ( ANY( BTEST( meas_flag(:,j,i), 0 ) ) )  THEN
796                      IF ( surf_lsm_h%start_index(j,i) <=                      &
797                           surf_lsm_h%end_index(j,i) )  THEN
798                         vmea(l)%ns_soil = vmea(l)%ns_soil +                   &
799                                                      nzt_soil - nzb_soil + 1 
800                      ENDIF
801                      IF ( surf_usm_h%start_index(j,i) <=                      &
802                           surf_usm_h%end_index(j,i) )  THEN
803                         vmea(l)%ns_soil = vmea(l)%ns_soil +                   &
804                                                      nzt_wall - nzb_wall + 1 
805                      ENDIF
806                   ENDIF
807                ENDDO
808             ENDDO
809          ENDIF         
810!
811!--       Allocate index arrays as well as array containing height information
812!--       for soil.
813          IF ( vmea(l)%soil_sampling )  THEN
814             ALLOCATE( vmea(l)%i_soil(1:vmea(l)%ns_soil) )
815             ALLOCATE( vmea(l)%j_soil(1:vmea(l)%ns_soil) )
816             ALLOCATE( vmea(l)%k_soil(1:vmea(l)%ns_soil) )
817             ALLOCATE( vmea(l)%depth(1:vmea(l)%ns_soil) )
818          ENDIF     
819!
820!--       For soil, store the grid indices.
821          ns = 0
822          IF ( vmea(l)%soil_sampling )  THEN
823             DO  i = nxl, nxr
824                DO  j = nys, nyn
825                   IF ( ANY( BTEST( meas_flag(:,j,i), 0 ) ) )  THEN
826                      IF ( surf_lsm_h%start_index(j,i) <=                      &
827                           surf_lsm_h%end_index(j,i) )  THEN
828                         m = surf_lsm_h%start_index(j,i)
829                         DO  k = nzb_soil, nzt_soil
830                            ns = ns + 1
831                            vmea(l)%i_soil(ns) = i
832                            vmea(l)%j_soil(ns) = j
833                            vmea(l)%k_soil(ns) = k
834                            vmea(l)%depth(ns)  = zs(k)
835                         ENDDO
836                      ENDIF
837                     
838                      IF ( surf_usm_h%start_index(j,i) <=                      &
839                           surf_usm_h%end_index(j,i) )  THEN
840                         m = surf_usm_h%start_index(j,i)
841                         DO  k = nzb_wall, nzt_wall
842                            ns = ns + 1
843                            vmea(l)%i_soil(ns) = i
844                            vmea(l)%j_soil(ns) = j
845                            vmea(l)%k_soil(ns) = k
846                            vmea(l)%depth(ns)  = surf_usm_h%zw(k,m)
847                         ENDDO
848                      ENDIF
849                   ENDIF
850                ENDDO
851             ENDDO
852          ENDIF
853!
[3434]854!--       Allocate array to save the sampled values.
[3704]855          ALLOCATE( vmea(l)%measured_vars(1:vmea(l)%ns,1:vmea(l)%nvar) )
856         
857          IF ( vmea(l)%soil_sampling )                                         &
858             ALLOCATE( vmea(l)%measured_vars_soil(1:vmea(l)%ns_soil,           &
859                                                  1:vmea(l)%nvar) )
[3434]860!
[3704]861!--       Initialize with _FillValues
862          vmea(l)%measured_vars(1:vmea(l)%ns,1:vmea(l)%nvar) = vmea(l)%fillout
863          IF ( vmea(l)%soil_sampling )                                         &
864             vmea(l)%measured_vars_soil(1:vmea(l)%ns_soil,1:vmea(l)%nvar) =    &
865                                                                vmea(l)%fillout
[3434]866!
867!--       Deallocate temporary coordinate arrays
868          IF ( ALLOCATED( e_utm ) )  DEALLOCATE( e_utm )
869          IF ( ALLOCATED( n_utm ) )  DEALLOCATE( n_utm )
870          IF ( ALLOCATED( z_ag  ) )  DEALLOCATE( z_ag  )
[3704]871          IF ( ALLOCATED( z_ag  ) )  DEALLOCATE( vmea(l)%dim_t )
[3434]872       ENDIF
873    ENDDO
874!
875!-- Close input file for virtual measurements. Therefore, just call
876!-- the read attribute routine with the "close" option.
[3704]877    CALL netcdf_data_input_att( vmea_general%nvm, char_numstations,            &
878                                vmea_general%id_vm, '',                        &
[3434]879                                global_attribute, 'close', '' )
[3704]880!
881!-- Sum-up the number of observation coordiates, for atmosphere first.
882!-- This is actually only required for data output.
883    ALLOCATE( ns_all(1:vmea_general%nvm) )
884    ns_all = 0   
885#if defined( __parallel )
886    CALL MPI_ALLREDUCE( vmea(:)%ns, ns_all(:), vmea_general%nvm, MPI_INTEGER,  &
887                        MPI_SUM, comm2d, ierr )
888#else
889    ns_all(:) = vmea(:)%ns
890#endif
891    vmea(:)%ns_tot = ns_all(:)
892!
893!-- Now for soil
894    ns_all = 0   
895#if defined( __parallel )
896    CALL MPI_ALLREDUCE( vmea(:)%ns_soil, ns_all(:), vmea_general%nvm,          &
897                        MPI_INTEGER, MPI_SUM, comm2d, ierr )
898#else
899    ns_all(:) = vmea(:)%ns_soil
900#endif
901    vmea(:)%ns_soil_tot = ns_all(:)
902   
903    DEALLOCATE( ns_all )
[3522]904!                               
905!-- Dellocate flag array
906    DEALLOCATE( meas_flag )
[3704]907!
908!-- Initialize binary data output of virtual measurements.
909!-- Open binary output file.
910    CALL check_open( 27 )
911!
912!-- Output header information.
913    CALL vm_data_output
[3522]914       
[3434]915  END SUBROUTINE vm_init
916 
917 
918!------------------------------------------------------------------------------!
919! Description:
920! ------------
[3704]921!> Binary data output.
922!------------------------------------------------------------------------------!
923  SUBROUTINE vm_data_output
924   
925     USE pegrid
926   
927     IMPLICIT NONE
928         
929     INTEGER(iwp) ::  i         !< running index over IO blocks   
930     INTEGER(iwp) ::  l         !< running index over all stations
931     INTEGER(iwp) ::  n         !< running index over all measured variables at a station
932!
933!--  Header output on each PE
934     IF ( init )  THEN
935
936        DO  i = 0, io_blocks-1
937           IF ( i == io_group )  THEN
938              WRITE ( 27 )  'number of measurements            '
939              WRITE ( 27 )  vmea_general%nvm
940
941              DO  l = 1, vmea_general%nvm
942                 WRITE ( 27 )  'site                              '
943                 WRITE ( 27 )  vmea(l)%site
944                 WRITE ( 27 )  'file                              '
945                 WRITE ( 27 )  vmea(l)%filename_original
946                 WRITE ( 27 )  'feature_type                      '
947                 WRITE ( 27 )  vmea(l)%feature_type
948                 WRITE ( 27 )  'origin_x_obs                      '
949                 WRITE ( 27 )  vmea(l)%origin_x_obs
950                 WRITE ( 27 )  'origin_y_obs                      '
951                 WRITE ( 27 )  vmea(l)%origin_y_obs
952                 WRITE ( 27 )  'total number of observation points'                               
953                 WRITE ( 27 )  vmea(l)%ns_tot
954                 WRITE ( 27 )  'number of measured variables      '
955                 WRITE ( 27 )  vmea(l)%nvar
956                 WRITE ( 27 )  'variables                         '
957                 WRITE ( 27 )  vmea(l)%measured_vars_name(:)
958                 WRITE ( 27 )  'number of observation points      '
959                 WRITE ( 27 )  vmea(l)%ns
960                 WRITE ( 27 )  'E_UTM                             '
961                 WRITE ( 27 )  init_model%origin_x +                           &
962                        REAL( vmea(l)%i(1:vmea(l)%ns) + 0.5_wp, KIND = wp ) * dx
963                 WRITE ( 27 )  'N_UTM                             '
964                 WRITE ( 27 )  init_model%origin_y +                           &
965                        REAL( vmea(l)%j(1:vmea(l)%ns) + 0.5_wp, KIND = wp ) * dy
966                 WRITE ( 27 )  'Z_AG                              '
967                 WRITE ( 27 )  vmea(l)%z_ag(1:vmea(l)%ns)
968                 WRITE ( 27 )  'soil sampling                     '
969                 WRITE ( 27 )  MERGE( 'yes                               ',    &
970                                      'no                                ',    &
971                                      vmea(l)%soil_sampling )
972 
973                 IF ( vmea(l)%soil_sampling )  THEN                 
974                    WRITE ( 27 )  'total number of soil points       '                               
975                    WRITE ( 27 )  vmea(l)%ns_soil_tot
976                    print*, "vmea(l)%ns_soil_tot", vmea(l)%ns_soil_tot
977                    WRITE ( 27 )  'number of soil points             '
978                    WRITE ( 27 )  vmea(l)%ns_soil
979                    WRITE ( 27 )  'E_UTM soil                        '
980                    WRITE ( 27 )  init_model%origin_x +                        &
981                           REAL( vmea(l)%i_soil(1:vmea(l)%ns_soil) + 0.5_wp,   &
982                                 KIND = wp ) * dx
983                    WRITE ( 27 )  'N_UTM soil                        '
984                    WRITE ( 27 )  init_model%origin_y +                        &
985                           REAL( vmea(l)%j_soil(1:vmea(l)%ns_soil) + 0.5_wp,   &
986                                 KIND = wp ) * dy
987                    WRITE ( 27 )  'DEPTH                             '
988                    WRITE ( 27 )  vmea(l)%depth(1:vmea(l)%ns_soil)
989                 ENDIF
990              ENDDO
991
992           ENDIF
993        ENDDO
994       
995#if defined( __parallel )
996        CALL MPI_BARRIER( comm2d, ierr )
997#endif
998!
999!--     After header information is written, set control flag to .FALSE.
1000        init = .FALSE.
1001!
1002!--  Data output at each measurement timestep on each PE
1003     ELSE
1004        DO  i = 0, io_blocks-1
1005
1006           IF ( i == io_group )  THEN
1007              WRITE( 27 )  'output time                       '
1008              WRITE( 27 )  time_since_reference_point
1009              DO  l = 1, vmea_general%nvm
1010!
1011!--              Skip binary writing if no observation points are defined on PE
1012                 IF ( vmea(l)%ns < 1  .AND.  vmea(l)%ns_soil < 1)  CYCLE                 
1013                 DO  n = 1, vmea(l)%nvar
1014                    WRITE( 27 )  vmea(l)%measured_vars_name(n)
1015                    IF ( vmea(l)%soil_sampling  .AND.                           &
1016                         ANY( TRIM( vmea(l)%measured_vars_name(n))  ==          &
1017                              soil_vars ) )  THEN                   
1018                       WRITE( 27 )  vmea(l)%measured_vars_soil(:,n)
1019                    ELSE
1020                       WRITE( 27 )  vmea(l)%measured_vars(:,n)
1021                    ENDIF
1022                 ENDDO
1023           
1024              ENDDO
1025           ENDIF
1026        ENDDO
1027#if defined( __parallel )
1028        CALL MPI_BARRIER( comm2d, ierr )
1029#endif
1030     ENDIF
1031 
1032  END SUBROUTINE vm_data_output 
1033 
1034 
1035!------------------------------------------------------------------------------!
1036! Description:
1037! ------------
1038!> Write end-of-file statement as last action.
1039!------------------------------------------------------------------------------!
1040  SUBROUTINE vm_last_actions
1041   
1042     USE pegrid
1043   
1044     IMPLICIT NONE
1045         
1046     INTEGER(iwp) ::  i         !< running index over IO blocks   
1047     INTEGER(iwp) ::  l         !< running index over all stations
1048     INTEGER(iwp) ::  n         !< running index over all measured variables at a station
1049 
1050     DO  i = 0, io_blocks-1
1051        IF ( i == io_group )  THEN
1052           WRITE( 27 )  'EOF                               '
1053        ENDIF
1054     ENDDO
1055#if defined( __parallel )
1056        CALL MPI_BARRIER( comm2d, ierr )
1057#endif
1058!
1059!--  Close binary file
1060     CALL close_file( 27 )
1061 
1062  END SUBROUTINE vm_last_actions 
1063 
1064!------------------------------------------------------------------------------!
1065! Description:
1066! ------------
[3434]1067!> Sampling of the actual quantities along the observation coordinates
1068!------------------------------------------------------------------------------!
[3471]1069  SUBROUTINE vm_sampling
[3434]1070
[3522]1071    USE arrays_3d,                                                             &
1072        ONLY:  exner, pt, q, u, v, w
[3471]1073
[3522]1074    USE basic_constants_and_equations_mod,                                     &
1075        ONLY:  pi
[3434]1076   
[3522]1077    USE radiation_model_mod,                                                   &
1078        ONLY:  radiation 
1079
1080    USE surface_mod,                                                           &
1081        ONLY:  surf_def_h, surf_lsm_h, surf_usm_h
1082   
[3434]1083     IMPLICIT NONE
1084     
[3704]1085     INTEGER(iwp) ::  i         !< grid index in x-direction
1086     INTEGER(iwp) ::  j         !< grid index in y-direction
1087     INTEGER(iwp) ::  k         !< grid index in z-direction
1088     INTEGER(iwp) ::  ind_chem  !< dummy index to identify chemistry variable and translate it from (UC)2 standard to interal naming
1089     INTEGER(iwp) ::  l         !< running index over the number of stations
1090     INTEGER(iwp) ::  m         !< running index over all virtual observation coordinates
1091     INTEGER(iwp) ::  mm        !< index of surface element which corresponds to the virtual observation coordinate
1092     INTEGER(iwp) ::  n         !< running index over all measured variables at a station
1093     INTEGER(iwp) ::  nn        !< running index over the number of chemcal species
1094     
1095     LOGICAL ::  match_lsm !< flag indicating natural-type surface
1096     LOGICAL ::  match_usm !< flag indicating urban-type surface
[3434]1097!
[3704]1098!--  Loop over all sites.
1099     DO  l = 1, vmea_general%nvm
[3434]1100!
[3704]1101!--     At the beginning, set _FillValues
1102        IF ( ALLOCATED( vmea(l)%measured_vars      ) )                         &
1103           vmea(l)%measured_vars      = vmea(l)%fillout 
1104        IF ( ALLOCATED( vmea(l)%measured_vars_soil ) )                         &
1105           vmea(l)%measured_vars_soil = vmea(l)%fillout 
1106!
1107!--     Loop over all variables measured at this site. 
[3522]1108        DO  n = 1, vmea(l)%nvar
1109       
1110           SELECT CASE ( TRIM( vmea(l)%measured_vars_name(n) ) )
1111           
1112              CASE ( 'theta' )
1113                 IF ( .NOT. neutral )  THEN
1114                    DO  m = 1, vmea(l)%ns
1115                       k = vmea(l)%k(m)
1116                       j = vmea(l)%j(m)
1117                       i = vmea(l)%i(m)
[3704]1118                       vmea(l)%measured_vars(m,n) = pt(k,j,i)
[3522]1119                    ENDDO
1120                 ENDIF
1121                 
[3704]1122              CASE ( 'ta' )
[3522]1123                 IF ( .NOT. neutral )  THEN
1124                    DO  m = 1, vmea(l)%ns
1125                       k = vmea(l)%k(m)
1126                       j = vmea(l)%j(m)
1127                       i = vmea(l)%i(m)
[3704]1128                       vmea(l)%measured_vars(m,n) = pt(k,j,i) * exner( k )
[3522]1129                    ENDDO
1130                 ENDIF
[3704]1131             
1132              CASE ( 't_va' )
[3522]1133                 
1134              CASE ( 'hus', 'haa' )
1135                 IF ( humidity )  THEN
1136                    DO  m = 1, vmea(l)%ns
1137                       k = vmea(l)%k(m)
1138                       j = vmea(l)%j(m)
1139                       i = vmea(l)%i(m)
[3704]1140                       vmea(l)%measured_vars(m,n) = q(k,j,i)
[3522]1141                    ENDDO
1142                 ENDIF
1143                 
1144              CASE ( 'u', 'ua' )
1145                 DO  m = 1, vmea(l)%ns
1146                    k = vmea(l)%k(m)
1147                    j = vmea(l)%j(m)
1148                    i = vmea(l)%i(m)
[3704]1149                    vmea(l)%measured_vars(m,n) = 0.5_wp * ( u(k,j,i) + u(k,j,i+1) )
[3522]1150                 ENDDO
1151                 
1152              CASE ( 'v', 'va' )
1153                 DO  m = 1, vmea(l)%ns
1154                    k = vmea(l)%k(m)
1155                    j = vmea(l)%j(m)
1156                    i = vmea(l)%i(m)
[3704]1157                    vmea(l)%measured_vars(m,n) = 0.5_wp * ( v(k,j,i) + v(k,j+1,i) )
[3522]1158                 ENDDO
1159                 
1160              CASE ( 'w' )
1161                 DO  m = 1, vmea(l)%ns
[3704]1162                    k = MAX ( 1, vmea(l)%k(m) ) 
[3522]1163                    j = vmea(l)%j(m)
1164                    i = vmea(l)%i(m)
[3704]1165                    vmea(l)%measured_vars(m,n) = 0.5_wp * ( w(k,j,i) + w(k-1,j,i) )
[3522]1166                 ENDDO
1167                 
1168              CASE ( 'wspeed' )
1169                 DO  m = 1, vmea(l)%ns
1170                    k = vmea(l)%k(m)
1171                    j = vmea(l)%j(m)
1172                    i = vmea(l)%i(m)
[3704]1173                    vmea(l)%measured_vars(m,n) = SQRT(                         &
[3522]1174                                   ( 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) )**2 + &
1175                                   ( 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) )**2   &
1176                                                     )
1177                 ENDDO
1178                 
1179              CASE ( 'wdir' )
1180                 DO  m = 1, vmea(l)%ns
1181                    k = vmea(l)%k(m)
1182                    j = vmea(l)%j(m)
1183                    i = vmea(l)%i(m)
1184                   
[3704]1185                    vmea(l)%measured_vars(m,n) = ATAN2(                        &
[3522]1186                                       - 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ),   &
1187                                       - 0.5_wp * ( v(k,j,i) + v(k,j+1,i) )    &
1188                                                      ) * 180.0_wp / pi
1189                 ENDDO
[3704]1190                 
1191              CASE ( 'utheta' )
1192                 DO  m = 1, vmea(l)%ns
1193                    k = vmea(l)%k(m)
1194                    j = vmea(l)%j(m)
1195                    i = vmea(l)%i(m)
1196                    vmea(l)%measured_vars(m,n) = 0.5_wp *                      &
1197                                                 ( u(k,j,i) + u(k,j,i+1) ) *   &
1198                                                   pt(k,j,i)
1199                 ENDDO
1200                 
1201              CASE ( 'vtheta' )
1202                 DO  m = 1, vmea(l)%ns
1203                    k = vmea(l)%k(m)
1204                    j = vmea(l)%j(m)
1205                    i = vmea(l)%i(m)
1206                    vmea(l)%measured_vars(m,n) = 0.5_wp *                      &
1207                                                 ( v(k,j,i) + v(k,j+1,i) ) *   &
1208                                                   pt(k,j,i)
1209                 ENDDO
1210                 
1211              CASE ( 'wtheta' )
1212                 DO  m = 1, vmea(l)%ns
1213                    k = MAX ( 1, vmea(l)%k(m) )
1214                    j = vmea(l)%j(m)
1215                    i = vmea(l)%i(m)
1216                    vmea(l)%measured_vars(m,n) = 0.5_wp *                      &
1217                                                 ( w(k-1,j,i) + w(k,j,i) ) *   &
1218                                                   pt(k,j,i)
1219                 ENDDO
1220                 
1221              CASE ( 'uw' )
1222                 DO  m = 1, vmea(l)%ns
1223                    k = MAX ( 1, vmea(l)%k(m) )
1224                    j = vmea(l)%j(m)
1225                    i = vmea(l)%i(m)
1226                    vmea(l)%measured_vars(m,n) = 0.25_wp *                     &
1227                                                 ( w(k-1,j,i) + w(k,j,i) ) *   &
1228                                                 ( u(k,j,i)   + u(k,j,i+1) )
1229                 ENDDO
1230                 
1231              CASE ( 'vw' )
1232                 DO  m = 1, vmea(l)%ns
1233                    k = MAX ( 1, vmea(l)%k(m) )
1234                    j = vmea(l)%j(m)
1235                    i = vmea(l)%i(m)
1236                    vmea(l)%measured_vars(m,n) = 0.25_wp *                     &
1237                                                 ( w(k-1,j,i) + w(k,j,i) ) *   &
1238                                                 ( v(k,j,i)   + v(k,j+1,i) )
1239                 ENDDO
1240                 
1241              CASE ( 'uv' )
1242                 DO  m = 1, vmea(l)%ns
1243                    k = MAX ( 1, vmea(l)%k(m) )
1244                    j = vmea(l)%j(m)
1245                    i = vmea(l)%i(m)
1246                    vmea(l)%measured_vars(m,n) = 0.25_wp *                     &
1247                                                 ( u(k,j,i)   + u(k,j,i+1) ) * &
1248                                                 ( v(k,j,i)   + v(k,j+1,i) )
1249                 ENDDO
[3522]1250!
[3704]1251!--           List of variables may need extension.
1252              CASE ( 'mcpm1', 'mcpm2p5', 'mcpm10', 'mfco', 'mfno', 'mfno2',    & 
1253                     'tro3' )                     
1254                 IF ( air_chemistry )  THEN
1255!
1256!--                 First, search for the measured variable in the chem_vars
1257!--                 list, in order to get the internal name of the variable.
1258                    DO  nn = 1, UBOUND( chem_vars, 2 )
1259                       IF ( TRIM( vmea(l)%measured_vars_name(m) ) ==           &
1260                            TRIM( chem_vars(0,nn) ) )  ind_chem = nn
1261                    ENDDO
1262!
1263!--                 Run loop over all chemical species, if the measured
1264!--                 variable matches the interal name, sample the variable.
[3522]1265                    DO  nn = 1, nspec                   
[3704]1266                       IF ( TRIM( chem_vars(1,ind_chem) ) ==                   &
[3522]1267                            TRIM( chem_species(nn)%name ) )  THEN                           
1268                          DO  m = 1, vmea(l)%ns             
1269                             k = vmea(l)%k(m)
1270                             j = vmea(l)%j(m)
1271                             i = vmea(l)%i(m)                   
[3704]1272                             vmea(l)%measured_vars(m,n) =                      &
[3522]1273                                                   chem_species(nn)%conc(k,j,i)
1274                          ENDDO
1275                       ENDIF
1276                    ENDDO
1277                 ENDIF
1278                 
1279              CASE ( 'us' )
1280                 DO  m = 1, vmea(l)%ns
1281!
1282!--                 Surface data is only available on inner subdomains, not
1283!--                 on ghost points. Hence, limit the indices.
1284                    j = MERGE( vmea(l)%j(m), nys, vmea(l)%j(m) < nys )
1285                    j = MERGE( j           , nyn, j            > nyn )
1286                    i = MERGE( vmea(l)%i(m), nxl, vmea(l)%i(m) < nxl )
1287                    i = MERGE( i           , nxr, i            > nxr )
1288                   
1289                    DO  mm = surf_def_h(0)%start_index(j,i),                   &
1290                             surf_def_h(0)%end_index(j,i)
[3704]1291                       vmea(l)%measured_vars(m,n) = surf_def_h(0)%us(mm)
[3522]1292                    ENDDO
1293                    DO  mm = surf_lsm_h%start_index(j,i),                      &
1294                             surf_lsm_h%end_index(j,i)
[3704]1295                       vmea(l)%measured_vars(m,n) = surf_lsm_h%us(mm)
[3522]1296                    ENDDO
1297                    DO  mm = surf_usm_h%start_index(j,i),                      &
1298                             surf_usm_h%end_index(j,i)
[3704]1299                       vmea(l)%measured_vars(m,n) = surf_usm_h%us(mm)
[3522]1300                    ENDDO
1301                 ENDDO
1302                 
1303              CASE ( 'ts' )
1304                 DO  m = 1, vmea(l)%ns
1305!
1306!--                 Surface data is only available on inner subdomains, not
1307!--                 on ghost points. Hence, limit the indices.
1308                    j = MERGE( vmea(l)%j(m), nys, vmea(l)%j(m) < nys )
1309                    j = MERGE( j           , nyn, j            > nyn )
1310                    i = MERGE( vmea(l)%i(m), nxl, vmea(l)%i(m) < nxl )
1311                    i = MERGE( i           , nxr, i            > nxr )
1312                   
1313                    DO  mm = surf_def_h(0)%start_index(j,i),                   &
1314                             surf_def_h(0)%end_index(j,i)
[3704]1315                       vmea(l)%measured_vars(m,n) = surf_def_h(0)%ts(mm)
[3522]1316                    ENDDO
1317                    DO  mm = surf_lsm_h%start_index(j,i),                      &
1318                             surf_lsm_h%end_index(j,i)
[3704]1319                       vmea(l)%measured_vars(m,n) = surf_lsm_h%ts(mm)
[3522]1320                    ENDDO
1321                    DO  mm = surf_usm_h%start_index(j,i),                      &
1322                             surf_usm_h%end_index(j,i)
[3704]1323                       vmea(l)%measured_vars(m,n) = surf_usm_h%ts(mm)
[3522]1324                    ENDDO
1325                 ENDDO
1326                 
1327              CASE ( 'hfls' )
1328                 DO  m = 1, vmea(l)%ns
1329!
1330!--                 Surface data is only available on inner subdomains, not
1331!--                 on ghost points. Hence, limit the indices.
1332                    j = MERGE( vmea(l)%j(m), nys, vmea(l)%j(m) < nys )
1333                    j = MERGE( j           , nyn, j            > nyn )
1334                    i = MERGE( vmea(l)%i(m), nxl, vmea(l)%i(m) < nxl )
1335                    i = MERGE( i           , nxr, i            > nxr )
1336                   
1337                    DO  mm = surf_def_h(0)%start_index(j,i),                   &
1338                             surf_def_h(0)%end_index(j,i)
[3704]1339                       vmea(l)%measured_vars(m,n) = surf_def_h(0)%qsws(mm)
[3522]1340                    ENDDO
1341                    DO  mm = surf_lsm_h%start_index(j,i),                      &
1342                             surf_lsm_h%end_index(j,i)
[3704]1343                       vmea(l)%measured_vars(m,n) = surf_lsm_h%qsws(mm)
[3522]1344                    ENDDO
1345                    DO  mm = surf_usm_h%start_index(j,i),                      &
1346                             surf_usm_h%end_index(j,i)
[3704]1347                       vmea(l)%measured_vars(m,n) = surf_usm_h%qsws(mm)
[3522]1348                    ENDDO
1349                 ENDDO
1350                 
1351              CASE ( 'hfss' )
1352                 DO  m = 1, vmea(l)%ns
1353!
1354!--                 Surface data is only available on inner subdomains, not
1355!--                 on ghost points. Hence, limit the indices.
1356                    j = MERGE( vmea(l)%j(m), nys, vmea(l)%j(m) < nys )
1357                    j = MERGE( j           , nyn, j            > nyn )
1358                    i = MERGE( vmea(l)%i(m), nxl, vmea(l)%i(m) < nxl )
1359                    i = MERGE( i           , nxr, i            > nxr )
1360                   
1361                    DO  mm = surf_def_h(0)%start_index(j,i),                   &
1362                             surf_def_h(0)%end_index(j,i)
[3704]1363                       vmea(l)%measured_vars(m,n) = surf_def_h(0)%shf(mm)
[3522]1364                    ENDDO
1365                    DO  mm = surf_lsm_h%start_index(j,i),                      &
1366                             surf_lsm_h%end_index(j,i)
[3704]1367                       vmea(l)%measured_vars(m,n) = surf_lsm_h%shf(mm)
[3522]1368                    ENDDO
1369                    DO  mm = surf_usm_h%start_index(j,i),                      &
1370                             surf_usm_h%end_index(j,i)
[3704]1371                       vmea(l)%measured_vars(m,n) = surf_usm_h%shf(mm)
[3522]1372                    ENDDO
1373                 ENDDO
1374                 
1375              CASE ( 'rnds' )
1376                 IF ( radiation )  THEN
1377                    DO  m = 1, vmea(l)%ns
1378!
1379!--                    Surface data is only available on inner subdomains, not
1380!--                    on ghost points. Hence, limit the indices.
1381                       j = MERGE( vmea(l)%j(m), nys, vmea(l)%j(m) < nys )
1382                       j = MERGE( j           , nyn, j            > nyn )
1383                       i = MERGE( vmea(l)%i(m), nxl, vmea(l)%i(m) < nxl )
1384                       i = MERGE( i           , nxr, i            > nxr )
1385                   
1386                       DO  mm = surf_lsm_h%start_index(j,i),                   &
1387                                surf_lsm_h%end_index(j,i)
[3704]1388                          vmea(l)%measured_vars(m,n) = surf_lsm_h%rad_net(mm)
[3522]1389                       ENDDO
1390                       DO  mm = surf_usm_h%start_index(j,i),                   &
1391                                surf_usm_h%end_index(j,i)
[3704]1392                          vmea(l)%measured_vars(m,n) = surf_usm_h%rad_net(mm)
[3522]1393                       ENDDO
1394                    ENDDO
1395                 ENDIF
1396                 
[3704]1397              CASE ( 'rsus' )
[3522]1398                 IF ( radiation )  THEN
1399                    DO  m = 1, vmea(l)%ns
1400!
1401!--                    Surface data is only available on inner subdomains, not
1402!--                    on ghost points. Hence, limit the indices.
1403                       j = MERGE( vmea(l)%j(m), nys, vmea(l)%j(m) < nys )
1404                       j = MERGE( j           , nyn, j            > nyn )
1405                       i = MERGE( vmea(l)%i(m), nxl, vmea(l)%i(m) < nxl )
1406                       i = MERGE( i           , nxr, i            > nxr )
1407                   
1408                       DO  mm = surf_lsm_h%start_index(j,i),                   &
1409                                surf_lsm_h%end_index(j,i)
[3704]1410                          vmea(l)%measured_vars(m,n) = surf_lsm_h%rad_sw_out(mm)
[3522]1411                       ENDDO
1412                       DO  mm = surf_usm_h%start_index(j,i),                   &
1413                                surf_usm_h%end_index(j,i)
[3704]1414                          vmea(l)%measured_vars(m,n) = surf_usm_h%rad_sw_out(mm)
[3522]1415                       ENDDO
1416                    ENDDO
1417                 ENDIF
1418                 
[3704]1419              CASE ( 'rsds' )
[3522]1420                 IF ( radiation )  THEN
1421                    DO  m = 1, vmea(l)%ns
1422!
1423!--                    Surface data is only available on inner subdomains, not
1424!--                    on ghost points. Hence, limit the indices.
1425                       j = MERGE( vmea(l)%j(m), nys, vmea(l)%j(m) < nys )
1426                       j = MERGE( j           , nyn, j            > nyn )
1427                       i = MERGE( vmea(l)%i(m), nxl, vmea(l)%i(m) < nxl )
1428                       i = MERGE( i           , nxr, i            > nxr )
1429                   
1430                       DO  mm = surf_lsm_h%start_index(j,i),                   &
1431                                surf_lsm_h%end_index(j,i)
[3704]1432                          vmea(l)%measured_vars(m,n) = surf_lsm_h%rad_sw_in(mm)
[3522]1433                       ENDDO
1434                       DO  mm = surf_usm_h%start_index(j,i),                   &
1435                                surf_usm_h%end_index(j,i)
[3704]1436                          vmea(l)%measured_vars(m,n) = surf_usm_h%rad_sw_in(mm)
[3522]1437                       ENDDO
1438                    ENDDO
1439                 ENDIF
1440                 
[3704]1441              CASE ( 'rlus' )
[3522]1442                 IF ( radiation )  THEN
1443                    DO  m = 1, vmea(l)%ns
1444!
1445!--                    Surface data is only available on inner subdomains, not
1446!--                    on ghost points. Hence, limit the indices.
1447                       j = MERGE( vmea(l)%j(m), nys, vmea(l)%j(m) < nys )
1448                       j = MERGE( j           , nyn, j            > nyn )
1449                       i = MERGE( vmea(l)%i(m), nxl, vmea(l)%i(m) < nxl )
1450                       i = MERGE( i           , nxr, i            > nxr )
1451                   
1452                       DO  mm = surf_lsm_h%start_index(j,i),                   &
1453                                surf_lsm_h%end_index(j,i)
[3704]1454                          vmea(l)%measured_vars(m,n) = surf_lsm_h%rad_lw_out(mm)
[3522]1455                       ENDDO
1456                       DO  mm = surf_usm_h%start_index(j,i),                   &
1457                                surf_usm_h%end_index(j,i)
[3704]1458                          vmea(l)%measured_vars(m,n) = surf_usm_h%rad_lw_out(mm)
[3522]1459                       ENDDO
1460                    ENDDO
1461                 ENDIF
1462                 
[3704]1463              CASE ( 'rlds' )
[3522]1464                 IF ( radiation )  THEN
1465                    DO  m = 1, vmea(l)%ns
1466!
1467!--                    Surface data is only available on inner subdomains, not
1468!--                    on ghost points. Hence, limit the indices.
1469                       j = MERGE( vmea(l)%j(m), nys, vmea(l)%j(m) < nys )
1470                       j = MERGE( j           , nyn, j            > nyn )
1471                       i = MERGE( vmea(l)%i(m), nxl, vmea(l)%i(m) < nxl )
1472                       i = MERGE( i           , nxr, i            > nxr )
1473                   
1474                       DO  mm = surf_lsm_h%start_index(j,i),                   &
1475                                surf_lsm_h%end_index(j,i)
[3704]1476                          vmea(l)%measured_vars(m,n) = surf_lsm_h%rad_lw_in(mm)
[3522]1477                       ENDDO
1478                       DO  mm = surf_usm_h%start_index(j,i),                   &
1479                                surf_usm_h%end_index(j,i)
[3704]1480                          vmea(l)%measured_vars(m,n) = surf_usm_h%rad_lw_in(mm)
[3522]1481                       ENDDO
1482                    ENDDO
1483                 ENDIF
[3704]1484                 
1485              CASE ( 'rsd' )
1486                 IF ( radiation )  THEN
1487                    DO  m = 1, vmea(l)%ns
1488                       k = MERGE( 0, vmea(l)%k(m), radiation_scheme /= 'rrtmg' ) 
1489                       j = vmea(l)%j(m)
1490                       i = vmea(l)%i(m)
1491                   
1492                       vmea(l)%measured_vars(m,n) = rad_sw_in(k,j,i)
1493                    ENDDO
1494                 ENDIF
1495                 
1496              CASE ( 'rsu' )
1497                 IF ( radiation )  THEN
1498                    DO  m = 1, vmea(l)%ns
1499                       k = MERGE( 0, vmea(l)%k(m), radiation_scheme /= 'rrtmg' ) 
1500                       j = vmea(l)%j(m)
1501                       i = vmea(l)%i(m)
1502                   
1503                       vmea(l)%measured_vars(m,n) = rad_sw_out(k,j,i)
1504                    ENDDO
1505                 ENDIF
1506                 
1507              CASE ( 'rlu' )
1508                 IF ( radiation )  THEN
1509                    DO  m = 1, vmea(l)%ns
1510                       k = MERGE( 0, vmea(l)%k(m), radiation_scheme /= 'rrtmg' ) 
1511                       j = vmea(l)%j(m)
1512                       i = vmea(l)%i(m)
1513                   
1514                       vmea(l)%measured_vars(m,n) = rad_lw_out(k,j,i)
1515                    ENDDO
1516                 ENDIF
1517                 
1518              CASE ( 'rld' )
1519                 IF ( radiation )  THEN
1520                    DO  m = 1, vmea(l)%ns
1521                       k = MERGE( 0, vmea(l)%k(m), radiation_scheme /= 'rrtmg' ) 
1522                       j = vmea(l)%j(m)
1523                       i = vmea(l)%i(m)
1524                   
1525                       vmea(l)%measured_vars(m,n) = rad_lw_in(k,j,i)
1526                    ENDDO
1527                 ENDIF
1528                 
1529              CASE ( 'rsddif' )
1530                 IF ( radiation )  THEN
1531                    DO  m = 1, vmea(l)%ns
1532                       j = vmea(l)%j(m)
1533                       i = vmea(l)%i(m)
1534                   
1535                       vmea(l)%measured_vars(m,n) = rad_sw_in_diff(j,i)
1536                    ENDDO
1537                 ENDIF
1538                 
1539              CASE ( 't_soil' )
1540                 DO  m = 1, vmea(l)%ns_soil
1541                    i = vmea(l)%i_soil(m)
1542                    j = vmea(l)%j_soil(m)
1543                    k = vmea(l)%k_soil(m)
1544                   
1545                    match_lsm = surf_lsm_h%start_index(j,i) <=                 &
1546                                surf_lsm_h%end_index(j,i)
1547                    match_usm = surf_usm_h%start_index(j,i) <=                 &
1548                                surf_usm_h%end_index(j,i)
1549                               
1550                    IF ( match_lsm )  THEN
1551                       mm = surf_lsm_h%start_index(j,i)
1552                       vmea(l)%measured_vars_soil(m,n) = t_soil_h%var_2d(k,mm)
1553                    ENDIF
1554                   
1555                    IF ( match_usm )  THEN
1556                       mm = surf_usm_h%start_index(j,i)
1557                       vmea(l)%measured_vars_soil(m,n) = t_wall_h(k,mm)
1558                    ENDIF
1559                 ENDDO
1560                 
1561              CASE ( 'm_soil' )
1562                 DO  m = 1, vmea(l)%ns_soil
1563                    i = vmea(l)%i_soil(m)
1564                    j = vmea(l)%j_soil(m)
1565                    k = vmea(l)%k_soil(m)
1566                   
1567                    match_lsm = surf_lsm_h%start_index(j,i) <=                 &
1568                                surf_lsm_h%end_index(j,i)
1569                               
1570                    IF ( match_lsm )  THEN
1571                       mm = surf_lsm_h%start_index(j,i)
1572                       vmea(l)%measured_vars_soil(m,n) = m_soil_h%var_2d(k,mm)
1573                    ENDIF
1574                   
1575                 ENDDO
[3522]1576!
1577!--           More will follow ...
[3704]1578
1579!
1580!--           No match found - just set a fill value
1581              CASE DEFAULT
1582                 vmea(l)%measured_vars(:,n) = vmea(l)%fillout
[3522]1583           END SELECT
1584
[3494]1585        ENDDO
[3434]1586
1587     ENDDO
[3704]1588         
[3471]1589  END SUBROUTINE vm_sampling
[3434]1590 
1591
[3471]1592 END MODULE virtual_measurement_mod
Note: See TracBrowser for help on using the repository browser.