Changeset 3779 for palm/trunk/UTIL/inifor/src/inifor.f90
- Timestamp:
- Mar 5, 2019 11:13:35 AM (5 years ago)
- File:
-
- 1 edited
-
palm/trunk/UTIL/inifor/src/inifor.f90 (modified) (14 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/UTIL/inifor/src/inifor.f90
r3680 r3779 15 15 ! PALM. If not, see <http://www.gnu.org/licenses/>. 16 16 ! 17 ! Copyright 2017-201 8Leibniz Universitaet Hannover18 ! Copyright 2017-201 8Deutscher Wetterdienst Offenbach17 ! Copyright 2017-2019 Leibniz Universitaet Hannover 18 ! Copyright 2017-2019 Deutscher Wetterdienst Offenbach 19 19 !------------------------------------------------------------------------------! 20 20 ! … … 26 26 ! ----------------- 27 27 ! $Id$ 28 ! Average geostrophic wind components on coarse COSMO levels instead of fine PALM levels 29 ! Remove --debug netCDF output of internal pressure profiles 30 ! 31 ! 3680 2019-01-18 14:54:12Z knoop 28 32 ! Prefixed all INIFOR modules with inifor_ 29 33 ! … … 74 78 !> and forcing data for the urban climate model PALM-4U. The required 75 79 !> meteorological fields are interpolated from output data of the mesoscale 76 !> model COSMO -DE. This is the main program file.80 !> model COSMO. This is the main program file. 77 81 !------------------------------------------------------------------------------! 78 82 PROGRAM inifor … … 91 95 USE inifor_io 92 96 USE inifor_transform, & 93 ONLY: average_profile, interpolate_2d, interpolate_3d, & 94 geostrophic_winds, extrapolate_density, extrapolate_pressure, & 95 get_surface_pressure 97 ONLY: average_pressure_perturbation, average_profile, interpolate_1d, & 98 interpolate_1d_arr, interpolate_2d, interpolate_3d, & 99 interp_average_profile, geostrophic_winds, extrapolate_density, & 100 extrapolate_pressure, get_surface_pressure 96 101 USE inifor_types 97 102 … … 104 109 REAL(dp), ALLOCATABLE, DIMENSION(:,:,:) :: output_arr !< array buffer for interpolated quantities 105 110 REAL(dp), ALLOCATABLE, DIMENSION(:), TARGET :: rho_centre !< density profile of the centre averaging domain 106 REAL(dp), ALLOCATABLE, DIMENSION(:), TARGET :: ug_arr !< geostrophic wind in x direction 107 REAL(dp), ALLOCATABLE, DIMENSION(:), TARGET :: vg_arr !< geostrophic wind in y direction 111 REAL(dp), ALLOCATABLE, DIMENSION(:), TARGET :: ug_cosmo !< profile of the geostrophic wind in x direction on COSMO levels 112 REAL(dp), ALLOCATABLE, DIMENSION(:), TARGET :: vg_cosmo !< profile of the geostrophic wind in y direction on COSMO levels 113 REAL(dp), ALLOCATABLE, DIMENSION(:), TARGET :: ug_palm !< profile of the geostrophic wind in x direction interpolated onto PALM levels 114 REAL(dp), ALLOCATABLE, DIMENSION(:), TARGET :: vg_palm !< profile of the geostrophic wind in y direction interpolated onto PALM levels 108 115 REAL(dp), ALLOCATABLE, DIMENSION(:), TARGET :: rho_north !< density profile of the northern averaging domain 109 116 REAL(dp), ALLOCATABLE, DIMENSION(:), TARGET :: rho_south !< density profile of the southern averaging domain … … 116 123 117 124 REAL(dp), POINTER, DIMENSION(:) :: internal_arr !< pointer to the currently processed internal array (density, pressure) 118 REAL(dp), POINTER, DIMENSION(:) :: ug_vg_ arr!< pointer to the currently processed geostrophic wind component125 REAL(dp), POINTER, DIMENSION(:) :: ug_vg_palm !< pointer to the currently processed geostrophic wind component 119 126 120 127 TYPE(nc_var), POINTER :: output_var !< pointer to the currently processed output variable … … 255 262 CALL run_control('time', 'alloc') 256 263 257 CALL average_profile(&264 CALL interp_average_profile( & 258 265 input_buffer(output_var % input_id) % array(:,:,:), & 259 266 output_arr(0,0,:), & … … 282 289 283 290 CASE('internal_density_centre') 284 ALLOCATE( rho_centre( 1: output_var % grid % nz) )291 ALLOCATE( rho_centre( 1:cosmo_grid % nz) ) 285 292 internal_arr => rho_centre 286 293 287 294 CASE('internal_density_north') 288 ALLOCATE( rho_north( 1: output_var % grid % nz) )295 ALLOCATE( rho_north( 1:cosmo_grid % nz) ) 289 296 internal_arr => rho_north 290 297 291 298 CASE('internal_density_south') 292 ALLOCATE( rho_south( 1: output_var % grid % nz) )299 ALLOCATE( rho_south( 1:cosmo_grid % nz) ) 293 300 internal_arr => rho_south 294 301 295 302 CASE('internal_density_east') 296 ALLOCATE( rho_east( 1: output_var %grid % nz) )303 ALLOCATE( rho_east( 1:cosmo_grid % nz) ) 297 304 internal_arr => rho_east 298 305 299 306 CASE('internal_density_west') 300 ALLOCATE( rho_west( 1: output_var % grid % nz) )307 ALLOCATE( rho_west( 1:cosmo_grid % nz) ) 301 308 internal_arr => rho_west 302 309 303 310 CASE('internal_pressure_north') 304 ALLOCATE( p_north( 1: output_var % grid % nz) )311 ALLOCATE( p_north( 1:cosmo_grid % nz) ) 305 312 internal_arr => p_north 306 313 307 314 CASE('internal_pressure_south') 308 ALLOCATE( p_south( 1: output_var % grid % nz) )315 ALLOCATE( p_south( 1:cosmo_grid % nz) ) 309 316 internal_arr => p_south 310 317 311 318 CASE('internal_pressure_east') 312 ALLOCATE( p_east( 1: output_var %grid % nz) )319 ALLOCATE( p_east( 1:cosmo_grid % nz) ) 313 320 internal_arr => p_east 314 321 315 322 CASE('internal_pressure_west') 316 ALLOCATE( p_west( 1: output_var % grid % nz) )323 ALLOCATE( p_west( 1:cosmo_grid % nz) ) 317 324 internal_arr => p_west 318 325 … … 324 331 325 332 326 CALL average_profile( & 327 input_buffer(output_var % input_id) % array(:,:,:),& 328 internal_arr(:), & 329 output_var % averaging_grid) 330 331 SELECT CASE (TRIM(output_var % name)) 332 333 CASE('internal_density_centre', & 334 'internal_density_north', & 335 'internal_density_south', & 336 'internal_density_east', & 337 'internal_density_west') 338 CALL extrapolate_density(internal_arr, & 339 output_var % averaging_grid) 340 341 CASE('internal_pressure_north') 342 CALL extrapolate_pressure(internal_arr, rho_north, & 343 output_var % averaging_grid) 344 345 CASE('internal_pressure_south') 346 CALL extrapolate_pressure(internal_arr, rho_south, & 347 output_var % averaging_grid) 348 349 CASE('internal_pressure_east') 350 CALL extrapolate_pressure(internal_arr, rho_east, & 351 output_var % averaging_grid) 352 353 CASE('internal_pressure_west') 354 CALL extrapolate_pressure(internal_arr, rho_west, & 355 output_var % averaging_grid) 333 SELECT CASE( TRIM( output_var % name ) ) 334 335 CASE( 'internal_pressure_north', & 336 'internal_pressure_south', & 337 'internal_pressure_east', & 338 'internal_pressure_west' ) 339 340 CALL average_pressure_perturbation( & 341 input_buffer(output_var % input_id) % array(:,:,:),& 342 internal_arr(:), & 343 cosmo_grid, output_var % averaging_grid & 344 ) 356 345 357 346 CASE DEFAULT 358 CALL inifor_abort('main loop', message) 347 348 CALL average_profile( & 349 input_buffer(output_var % input_id) % array(:,:,:),& 350 internal_arr(:), & 351 cosmo_grid, output_var % averaging_grid & 352 ) 359 353 360 354 END SELECT 361 355 362 IF (.TRUE.) THEN 363 ALLOCATE( output_arr(1,1,1:output_var % grid % nz) ) 364 output_arr(1,1,:) = internal_arr(:) 365 END IF 356 357 ! 358 !-- Output of geostrophic pressure profiles (with --debug 359 !-- option) is currently deactivated, since they are now 360 !-- defined on averaged COSMO levels instead of PALM levels 361 !-- (requires definiton of COSMO levels in netCDF output.) 362 !IF (.TRUE.) THEN 363 ! ALLOCATE( output_arr(1,1,1:output_var % grid % nz) ) 364 ! output_arr(1,1,:) = internal_arr(:) 365 !END IF 366 366 CALL run_control('time', 'comp') 367 367 … … 369 369 !-- This case gets called twice, the first time for ug, the 370 370 !-- second time for vg. We compute ug and vg at the first call 371 !-- and keep vg (and ug for that matter) around for the second 372 !-- call. 371 !-- and keep both of them around for the second call. 373 372 CASE ( 'geostrophic winds' ) 374 373 375 374 IF (.NOT. ug_vg_have_been_computed ) THEN 376 ALLOCATE( ug_arr(output_var % grid % nz) ) 377 ALLOCATE( vg_arr(output_var % grid % nz) ) 378 379 IF ( cfg % ug_is_set ) THEN 380 ug_arr = cfg % ug 381 vg_arr = cfg % vg 375 ALLOCATE( ug_palm(output_var % grid % nz) ) 376 ALLOCATE( vg_palm(output_var % grid % nz) ) 377 ALLOCATE( ug_cosmo(cosmo_grid % nz) ) 378 ALLOCATE( vg_cosmo(cosmo_grid % nz) ) 379 380 IF ( cfg % ug_defined_by_user ) THEN 381 ug_palm = cfg % ug 382 vg_palm = cfg % vg 382 383 ELSE 383 384 CALL geostrophic_winds( p_north, p_south, p_east, & … … 387 388 phi_n, lambda_n, & 388 389 phi_centre, lam_centre, & 389 ug_arr, vg_arr ) 390 ug_cosmo, vg_cosmo ) 391 392 CALL interpolate_1d( ug_cosmo, ug_palm, & 393 output_var % grid ) 394 395 CALL interpolate_1d( vg_cosmo, vg_palm, & 396 output_var % grid ) 390 397 END IF 391 398 … … 395 402 396 403 ! 397 !-- Prepare output of geostrophic winds404 !-- Select output array of current geostrophic wind component 398 405 SELECT CASE(TRIM(output_var % name)) 399 406 CASE ('ls_forcing_ug') 400 ug_vg_ arr => ug_arr407 ug_vg_palm => ug_palm 401 408 CASE ('ls_forcing_vg') 402 ug_vg_ arr => vg_arr409 ug_vg_palm => vg_palm 403 410 END SELECT 404 411 405 412 ALLOCATE( output_arr(1,1,output_var % grid % nz) ) 406 output_arr(1,1,:) = ug_vg_ arr(:)413 output_arr(1,1,:) = ug_vg_palm(:) 407 414 408 415 CASE ( 'average scalar' ) … … 447 454 !- Section 2.3: Write current time step of current variable 448 455 !------------------------------------------------------------------------------ 449 IF (.NOT. output_var % is_internal .OR. debugging_output) THEN 456 ! 457 !-- Output of geostrophic pressure profiles (with --debug 458 !-- option) is currently deactivated, since they are now 459 !-- defined on averaged COSMO levels instead of PALM levels 460 !-- (requires definiton of COSMO levels in netCDF output.) 461 !IF (.NOT. output_var % is_internal .OR. debugging_output) THEN 462 463 IF (.NOT. output_var % is_internal) THEN 450 464 message = "Writing variable '" // TRIM(output_var%name) // "'." 451 465 CALL report('main loop', message) … … 467 481 IF ( group % kind == 'thermodynamics' ) THEN 468 482 DEALLOCATE( rho_centre ) 469 DEALLOCATE( ug_arr ) 470 DEALLOCATE( vg_arr ) 471 IF ( .NOT. cfg % ug_is_set ) THEN 483 DEALLOCATE( ug_palm ) 484 DEALLOCATE( vg_palm ) 485 DEALLOCATE( ug_cosmo ) 486 DEALLOCATE( vg_cosmo ) 487 IF ( .NOT. cfg % ug_defined_by_user ) THEN 472 488 DEALLOCATE( rho_north ) 473 489 DEALLOCATE( rho_south )
Note: See TracChangeset
for help on using the changeset viewer.
