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