Changeset 3866 for palm/trunk/UTIL/inifor/src/inifor.f90
- Timestamp:
- Apr 5, 2019 2:25:01 PM (5 years ago)
- File:
-
- 1 edited
-
palm/trunk/UTIL/inifor/src/inifor.f90 (modified) (15 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/UTIL/inifor/src/inifor.f90
r3785 r3866 26 26 ! ----------------- 27 27 ! $Id$ 28 ! Use PALM's working precision 29 ! Show error message if compiled without netCDF support 30 ! Renamed run_control -> log_runtime 31 ! Improved coding style added comments 32 ! 33 ! 34 ! 3785 2019-03-06 10:41:14Z eckhard 28 35 ! Average geostrophic wind components on coarse COSMO levels instead of fine PALM levels 29 36 ! Remove --debug netCDF output of internal pressure profiles … … 81 88 !------------------------------------------------------------------------------! 82 89 PROGRAM inifor 90 83 91 #if defined ( __netcdf ) 84 92 … … 86 94 USE inifor_defs 87 95 USE inifor_grid, & 88 ONLY: setup_parameters, setup_grids, setup_variable_tables, & 89 setup_io_groups, fini_grids, fini_variables, fini_io_groups, & 90 fini_file_lists, preprocess, origin_lon, origin_lat, & 91 output_file, io_group_list, output_var_table, & 92 cosmo_grid, palm_grid, nx, ny, nz, p0, cfg, f3, & 93 averaging_width_ns, averaging_width_ew, phi_n, lambda_n, & 94 lam_centre, phi_centre 96 ONLY: averaging_width_ns, & 97 averaging_width_ew, & 98 cfg, & 99 cosmo_grid, & 100 f3, & 101 fini_grids, & 102 fini_io_groups, & 103 fini_variables, & 104 fini_file_lists, & 105 io_group_list, & 106 lam_centre, & 107 lambda_n, & 108 nx, ny, nz, & 109 origin_lat, & 110 origin_lon, & 111 output_file, & 112 output_var_table, & 113 p0, & 114 phi_centre, & 115 phi_n, & 116 preprocess, & 117 palm_grid, & 118 setup_grids, & 119 setup_parameters, & 120 setup_variable_tables, & 121 setup_io_groups 95 122 USE inifor_io 96 123 USE inifor_transform, & 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 124 ONLY: average_pressure_perturbation, & 125 average_profile, & 126 extrapolate_density, & 127 extrapolate_pressure, & 128 geostrophic_winds, & 129 get_surface_pressure, & 130 interp_average_profile, & 131 interpolate_1d, & 132 interpolate_1d_arr, & 133 interpolate_2d, & 134 interpolate_3d 101 135 USE inifor_types 102 136 … … 107 141 INTEGER :: iter !< loop index for time steps 108 142 109 REAL( dp), ALLOCATABLE, DIMENSION(:,:,:) :: output_arr !< array buffer for interpolated quantities110 REAL( dp), ALLOCATABLE, DIMENSION(:), TARGET :: rho_centre !< density profile of the centre averaging domain111 REAL( dp), ALLOCATABLE, DIMENSION(:), TARGET :: ug_cosmo !< profile of the geostrophic wind in x direction on COSMO levels112 REAL( dp), ALLOCATABLE, DIMENSION(:), TARGET :: vg_cosmo !< profile of the geostrophic wind in y direction on COSMO levels113 REAL( dp), ALLOCATABLE, DIMENSION(:), TARGET :: ug_palm !< profile of the geostrophic wind in x direction interpolated onto PALM levels114 REAL( dp), ALLOCATABLE, DIMENSION(:), TARGET :: vg_palm !< profile of the geostrophic wind in y direction interpolated onto PALM levels115 REAL( dp), ALLOCATABLE, DIMENSION(:), TARGET :: rho_north !< density profile of the northern averaging domain116 REAL( dp), ALLOCATABLE, DIMENSION(:), TARGET :: rho_south !< density profile of the southern averaging domain117 REAL( dp), ALLOCATABLE, DIMENSION(:), TARGET :: rho_east !< density profile of the eastern averaging domain118 REAL( dp), ALLOCATABLE, DIMENSION(:), TARGET :: rho_west !< density profile of the western averaging domain119 REAL( dp), ALLOCATABLE, DIMENSION(:), TARGET :: p_north !< pressure profile of the northern averaging domain120 REAL( dp), ALLOCATABLE, DIMENSION(:), TARGET :: p_south !< pressure profile of the southern averaging domain121 REAL( dp), ALLOCATABLE, DIMENSION(:), TARGET :: p_east !< pressure profile of the eastern averaging domain122 REAL( dp), ALLOCATABLE, DIMENSION(:), TARGET :: p_west !< pressure profile of the western averaging domain123 124 REAL( dp), POINTER, DIMENSION(:) :: internal_arr !< pointer to the currently processed internal array (density, pressure)125 REAL( dp), POINTER, DIMENSION(:) :: ug_vg_palm !< pointer to the currently processed geostrophic wind component143 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: output_arr !< array buffer for interpolated quantities 144 REAL(wp), ALLOCATABLE, DIMENSION(:), TARGET :: rho_centre !< density profile of the centre averaging domain 145 REAL(wp), ALLOCATABLE, DIMENSION(:), TARGET :: ug_cosmo !< profile of the geostrophic wind in x direction on COSMO levels 146 REAL(wp), ALLOCATABLE, DIMENSION(:), TARGET :: vg_cosmo !< profile of the geostrophic wind in y direction on COSMO levels 147 REAL(wp), ALLOCATABLE, DIMENSION(:), TARGET :: ug_palm !< profile of the geostrophic wind in x direction interpolated onto PALM levels 148 REAL(wp), ALLOCATABLE, DIMENSION(:), TARGET :: vg_palm !< profile of the geostrophic wind in y direction interpolated onto PALM levels 149 REAL(wp), ALLOCATABLE, DIMENSION(:), TARGET :: rho_north !< density profile of the northern averaging domain 150 REAL(wp), ALLOCATABLE, DIMENSION(:), TARGET :: rho_south !< density profile of the southern averaging domain 151 REAL(wp), ALLOCATABLE, DIMENSION(:), TARGET :: rho_east !< density profile of the eastern averaging domain 152 REAL(wp), ALLOCATABLE, DIMENSION(:), TARGET :: rho_west !< density profile of the western averaging domain 153 REAL(wp), ALLOCATABLE, DIMENSION(:), TARGET :: p_north !< pressure profile of the northern averaging domain 154 REAL(wp), ALLOCATABLE, DIMENSION(:), TARGET :: p_south !< pressure profile of the southern averaging domain 155 REAL(wp), ALLOCATABLE, DIMENSION(:), TARGET :: p_east !< pressure profile of the eastern averaging domain 156 REAL(wp), ALLOCATABLE, DIMENSION(:), TARGET :: p_west !< pressure profile of the western averaging domain 157 158 REAL(wp), POINTER, DIMENSION(:) :: internal_arr !< pointer to the currently processed internal array (density, pressure) 159 REAL(wp), POINTER, DIMENSION(:) :: ug_vg_palm !< pointer to the currently processed geostrophic wind component 126 160 127 161 TYPE(nc_var), POINTER :: output_var !< pointer to the currently processed output variable … … 138 172 !- Section 1: Initialization 139 173 !------------------------------------------------------------------------------ 140 CALL run_control('init', 'void')174 CALL log_runtime( 'init', 'void' ) 141 175 142 176 ! 143 177 !-- Initialize INIFOR's parameters from command-line interface and namelists 144 CALL setup_parameters ()178 CALL setup_parameters 145 179 146 180 ! 147 181 !-- Initialize all grids, including interpolation neighbours and weights 148 CALL setup_grids ()149 CALL run_control('time', 'init')182 CALL setup_grids 183 CALL log_runtime( 'time', 'init' ) 150 184 151 185 ! 152 186 !-- Initialize the netCDF output file and define dimensions 153 CALL setup_netcdf_dimensions(output_file, palm_grid, cfg %start_date, &187 CALL setup_netcdf_dimensions(output_file, palm_grid, cfg%start_date, & 154 188 origin_lon, origin_lat) 155 CALL run_control('time', 'write')189 CALL log_runtime( 'time', 'write' ) 156 190 157 191 ! 158 192 !-- Set up the tables containing the input and output variables and set 159 193 !-- the corresponding netCDF dimensions for each output variable 160 CALL setup_variable_tables( cfg % ic_mode)161 CALL run_control('time', 'write')194 CALL setup_variable_tables( cfg%ic_mode ) 195 CALL log_runtime( 'time', 'write' ) 162 196 163 197 ! 164 198 !-- Add the output variables to the netCDF output file 165 CALL setup_netcdf_variables(output_file % name, output_var_table) 166 167 CALL setup_io_groups() 168 CALL run_control('time', 'init') 169 170 !------------------------------------------------------------------------------ 171 !- Section 2: Main loop 172 !------------------------------------------------------------------------------ 173 DO igroup = 1, SIZE(io_group_list) 199 CALL setup_netcdf_variables( output_file%name, output_var_table ) 200 201 CALL setup_io_groups 202 CALL log_runtime( 'time', 'init' ) 203 204 !------------------------------------------------------------------------------ 205 !-- Section 2: Main loop 206 !------------------------------------------------------------------------------ 207 ! 208 !-- Input and output variables are organized into IO groups. For instance, the 209 !-- 'thermodynamics' IO group bundles the input variaebls T, P, QV and the 210 !-- output variables p, theta, rho, and qv. 211 !-- An IO group bunldes variables that are physically dependent on each other. 212 !-- In case of the 'thermodynamics' group, theta = f(P,T), rho = f(P,T,QV). 213 DO igroup = 1, SIZE( io_group_list ) 174 214 175 215 group => io_group_list(igroup) 176 IF ( group %to_be_processed ) THEN216 IF ( group%to_be_processed ) THEN 177 217 178 DO iter = 1, group % nt 179 180 !------------------------------------------------------------------------------ 181 !- Section 2.1: Read and preprocess input data 182 !------------------------------------------------------------------------------ 183 CALL read_input_variables(group, iter, input_buffer) 184 CALL run_control('time', 'read') 185 186 CALL preprocess(group, input_buffer, cosmo_grid, iter) 187 CALL run_control('time', 'comp') 218 !-- Loop over all output time steps for the current group. 219 DO iter = 1, group%nt 220 221 !------------------------------------------------------------------------------ 222 !-- Section 2.1: Read and preprocess input data 223 !------------------------------------------------------------------------------ 224 CALL read_input_variables( group, iter, input_buffer ) 225 CALL log_runtime( 'time', 'read' ) 226 227 !-- Carry out all required physical conversion of the input variables 228 !-- of the current IO group on the input (COSMO) grid. For instance, 229 !-- horizontal velocities are rotated to the PALM coordinate system and 230 !-- potential temperature is computed from the absolute temperature and 231 !-- pressure. 232 CALL preprocess( group, input_buffer, cosmo_grid, iter ) 233 CALL log_runtime( 'time', 'comp' ) 188 234 189 235 !TODO: move this assertion into 'preprocess'. 190 IF ( .NOT. ALL(input_buffer(:) %is_preprocessed .AND. .TRUE.) ) THEN191 message = "Input buffers for group '" // TRIM( group % kind) // &192 "' could not be preprocessed sucessfully."193 CALL inifor_abort( 'main loop', message)236 IF ( .NOT. ALL(input_buffer(:)%is_preprocessed .AND. .TRUE.) ) THEN 237 message = "Input buffers for group '" // TRIM( group%kind ) // & 238 "' could not be preprocessed sucessfully." 239 CALL inifor_abort( 'main loop', message ) 194 240 ENDIF 195 241 196 242 !------------------------------------------------------------------------------ 197 !- Section 2.2: Interpolate each output variable of the group 198 !------------------------------------------------------------------------------ 199 DO ivar = 1, group % nv 200 201 output_var => group % out_vars( ivar ) 202 203 IF ( output_var % to_be_processed .AND. & 204 iter .LE. output_var % nt ) THEN 205 206 message = "Processing '" // TRIM(output_var % name) // & 207 "' (" // TRIM(output_var % kind) // & 208 "), iteration " // TRIM(str(iter)) //" of " // & 209 TRIM(str(output_var % nt)) 210 CALL report('main loop', message) 211 212 SELECT CASE( TRIM(output_var % task) ) 213 214 CASE( 'interpolate_2d' ) 215 216 SELECT CASE( TRIM(output_var % kind) ) 217 218 CASE( 'init soil' ) 219 220 ALLOCATE( output_arr( 0:output_var % grid % nx, & 221 0:output_var % grid % ny, & 222 SIZE(output_var % grid % depths) ) ) 223 224 CASE ( 'surface forcing' ) 225 226 ALLOCATE( output_arr( 0:output_var % grid % nx, & 227 0:output_var % grid % ny, 1 ) ) 228 229 CASE DEFAULT 230 231 message = "'" // TRIM(output_var % kind) // "' is not a soil variable" 232 CALL inifor_abort("main loop", message) 233 234 END SELECT 235 CALL run_control('time', 'alloc') 236 237 CALL interpolate_2d(input_buffer(output_var % input_id) % array(:,:,:), & 238 output_arr(:,:,:), output_var % intermediate_grid, output_var) 239 CALL run_control('time', 'comp') 240 241 242 CASE ( 'interpolate_3d' ) 243 244 ALLOCATE( output_arr( 0:output_var % grid % nx, & 245 0:output_var % grid % ny, & 246 1:output_var % grid % nz ) ) 247 248 CALL run_control('time', 'alloc') 249 CALL interpolate_3d( & 250 input_buffer(output_var % input_id) % array(:,:,:), & 251 output_arr(:,:,:), & 252 output_var % intermediate_grid, & 253 output_var % grid) 254 CALL run_control('time', 'comp') 255 256 CASE ( 'average profile' ) 257 258 ALLOCATE( output_arr( 0:output_var % grid % nx, & 259 0:output_var % grid % ny, & 260 1:output_var % grid % nz ) ) 261 CALL run_control('time', 'alloc') 243 !-- Section 2.2: Interpolate each output variable of the group 244 !------------------------------------------------------------------------------ 245 DO ivar = 1, group%nv 246 247 output_var => group%out_vars(ivar) 248 249 IF ( output_var%to_be_processed .AND. & 250 iter .LE. output_var%nt ) THEN 251 252 message = "Processing '" // TRIM( output_var%name ) // & 253 "' (" // TRIM( output_var%kind ) // & 254 "), iteration " // TRIM( str( iter ) ) //" of " //& 255 TRIM( str( output_var%nt ) ) 256 CALL report( 'main loop', message ) 257 258 SELECT CASE( TRIM( output_var%task ) ) 259 260 !-- 2D horizontal interpolation 261 CASE( 'interpolate_2d' ) 262 262 263 CALL interp_average_profile( & 264 input_buffer(output_var % input_id) % array(:,:,:), & 265 output_arr(0,0,:), & 266 output_var % averaging_grid) 267 268 IF ( TRIM(output_var % name) == & 269 'surface_forcing_surface_pressure' ) THEN 270 271 IF ( cfg % p0_is_set ) THEN 272 output_arr(0,0,1) = p0 273 ELSE 274 CALL get_surface_pressure( & 275 output_arr(0,0,:), rho_centre, & 276 output_var % averaging_grid) 263 SELECT CASE( TRIM( output_var%kind ) ) 264 265 CASE( 'init soil' ) 266 267 ALLOCATE( output_arr(0:output_var%grid%nx, & 268 0:output_var%grid%ny, & 269 SIZE( output_var%grid%depths )) ) 270 271 CASE ( 'surface forcing' ) 272 273 ALLOCATE( output_arr(0:output_var%grid%nx, & 274 0:output_var%grid%ny, 1) ) 275 276 CASE DEFAULT 277 278 message = "'" // TRIM( output_var%kind ) // "' is not a soil variable" 279 CALL inifor_abort( "main loop", message ) 280 281 END SELECT 282 CALL log_runtime( 'time', 'alloc' ) 283 284 CALL interpolate_2d( input_buffer(output_var%input_id)%array(:,:,:), & 285 output_arr(:,:,:), output_var%intermediate_grid, output_var ) 286 CALL log_runtime( 'time', 'comp' ) 287 288 289 !-- Interpolation in 3D, used for atmospheric initial and 290 !-- boundary conditions. 291 CASE ( 'interpolate_3d' ) 292 293 ALLOCATE( output_arr(0:output_var%grid % nx, & 294 0:output_var%grid % ny, & 295 1:output_var%grid % nz) ) 296 297 CALL log_runtime( 'time', 'alloc' ) 298 CALL interpolate_3d( & 299 input_buffer(output_var%input_id)%array(:,:,:), & 300 output_arr(:,:,:), & 301 output_var%intermediate_grid, & 302 output_var%grid) 303 CALL log_runtime( 'time', 'comp' ) 304 305 !-- Compute initial avaerage profiles (if --init-mode profile 306 !-- is used) 307 CASE ( 'average profile' ) 308 309 ALLOCATE( output_arr(0:output_var%grid%nx, & 310 0:output_var%grid%ny, & 311 1:output_var%grid%nz) ) 312 CALL log_runtime( 'time', 'alloc' ) 313 314 CALL interp_average_profile( & 315 input_buffer(output_var%input_id)%array(:,:,:), & 316 output_arr(0,0,:), & 317 output_var%averaging_grid ) 318 319 IF ( TRIM( output_var%name ) == & 320 'surface_forcing_surface_pressure' ) THEN 321 322 IF ( cfg%p0_is_set ) THEN 323 output_arr(0,0,1) = p0 324 ELSE 325 CALL get_surface_pressure( & 326 output_arr(0,0,:), rho_centre, & 327 output_var%averaging_grid ) 328 ENDIF 329 277 330 ENDIF 278 279 ENDIF280 CALL run_control('time', 'comp') 281 282 CASE ( 'internal profile' )283 284 message = "Averaging of internal profile for variable '" //&285 TRIM(output_var % name) // "' is not supported."286 287 SELECT CASE (TRIM(output_var % name))288 289 CASE('internal_density_centre')290 ALLOCATE( rho_centre( 1:cosmo_grid %nz) )291 internal_arr => rho_centre292 293 CASE('internal_density_north')294 ALLOCATE( rho_north( 1:cosmo_grid %nz) )295 internal_arr => rho_north296 297 CASE('internal_density_south')298 ALLOCATE( rho_south( 1:cosmo_grid %nz) )299 internal_arr => rho_south300 301 CASE('internal_density_east')302 ALLOCATE( rho_east( 1:cosmo_grid %nz) )303 internal_arr => rho_east304 305 CASE('internal_density_west')306 ALLOCATE( rho_west( 1:cosmo_grid %nz) )307 internal_arr => rho_west308 309 CASE('internal_pressure_north')310 ALLOCATE( p_north( 1:cosmo_grid %nz) )311 internal_arr => p_north312 313 CASE('internal_pressure_south')314 ALLOCATE( p_south( 1:cosmo_grid %nz) )315 internal_arr => p_south316 317 CASE('internal_pressure_east')318 ALLOCATE( p_east( 1:cosmo_grid %nz) )319 internal_arr => p_east320 321 CASE('internal_pressure_west')322 ALLOCATE( p_west( 1:cosmo_grid %nz) )323 internal_arr => p_west324 325 CASE DEFAULT326 CALL inifor_abort('main loop', message)327 328 END SELECT329 CALL run_control('time', 'alloc')330 331 332 SELECT CASE( TRIM( output_var %name ) )333 334 CASE( 'internal_pressure_north', &335 'internal_pressure_south', &336 'internal_pressure_east', &337 'internal_pressure_west' )338 339 CALL average_pressure_perturbation( &340 input_buffer(output_var %input_id) % array(:,:,:),&341 internal_arr(:), &342 cosmo_grid, output_var %averaging_grid &343 )344 345 CASE DEFAULT346 347 CALL average_profile( &348 input_buffer(output_var %input_id) % array(:,:,:),&349 internal_arr(:), &350 output_var %averaging_grid &351 )331 CALL log_runtime( 'time', 'comp' ) 332 333 !-- Compute internal profiles, required for differentiation of 334 !-- geostrophic wind 335 CASE ( 'internal profile' ) 336 337 message = "Averaging of internal profile for variable '" //& 338 TRIM( output_var%name ) // "' is not supported." 339 340 SELECT CASE ( TRIM( output_var%name ) ) 341 342 CASE( 'internal_density_centre' ) 343 ALLOCATE( rho_centre(1:cosmo_grid%nz) ) 344 internal_arr => rho_centre 345 346 CASE( 'internal_density_north' ) 347 ALLOCATE( rho_north(1:cosmo_grid%nz) ) 348 internal_arr => rho_north 349 350 CASE( 'internal_density_south' ) 351 ALLOCATE( rho_south(1:cosmo_grid%nz) ) 352 internal_arr => rho_south 353 354 CASE( 'internal_density_east' ) 355 ALLOCATE( rho_east(1:cosmo_grid%nz) ) 356 internal_arr => rho_east 357 358 CASE( 'internal_density_west' ) 359 ALLOCATE( rho_west(1:cosmo_grid%nz) ) 360 internal_arr => rho_west 361 362 CASE( 'internal_pressure_north' ) 363 ALLOCATE( p_north(1:cosmo_grid%nz) ) 364 internal_arr => p_north 365 366 CASE( 'internal_pressure_south' ) 367 ALLOCATE( p_south(1:cosmo_grid%nz) ) 368 internal_arr => p_south 369 370 CASE( 'internal_pressure_east' ) 371 ALLOCATE( p_east(1:cosmo_grid%nz) ) 372 internal_arr => p_east 373 374 CASE( 'internal_pressure_west' ) 375 ALLOCATE( p_west(1:cosmo_grid%nz) ) 376 internal_arr => p_west 377 378 CASE DEFAULT 379 CALL inifor_abort( 'main loop', message ) 380 381 END SELECT 382 CALL log_runtime( 'time', 'alloc' ) 383 384 385 SELECT CASE( TRIM( output_var%name ) ) 386 387 CASE( 'internal_pressure_north', & 388 'internal_pressure_south', & 389 'internal_pressure_east', & 390 'internal_pressure_west' ) 391 392 CALL average_pressure_perturbation( & 393 input_buffer(output_var%input_id) % array(:,:,:),& 394 internal_arr(:), & 395 cosmo_grid, output_var%averaging_grid & 396 ) 397 398 CASE DEFAULT 399 400 CALL average_profile( & 401 input_buffer(output_var%input_id) % array(:,:,:),& 402 internal_arr(:), & 403 output_var%averaging_grid & 404 ) 352 405 353 406 END SELECT … … 360 413 !-- (requires definiton of COSMO levels in netCDF output.) 361 414 !IF (.TRUE.) THEN 362 ! ALLOCATE( output_arr(1,1,1:output_var %grid % nz) )415 ! ALLOCATE( output_arr(1,1,1:output_var%grid % nz) ) 363 416 ! output_arr(1,1,:) = internal_arr(:) 364 417 !ENDIF 365 CALL run_control('time', 'comp')418 CALL log_runtime( 'time', 'comp' ) 366 419 367 420 ! … … 372 425 373 426 IF (.NOT. ug_vg_have_been_computed ) THEN 374 ALLOCATE( ug_palm(output_var % grid %nz) )375 ALLOCATE( vg_palm(output_var % grid %nz) )376 ALLOCATE( ug_cosmo(cosmo_grid %nz) )377 ALLOCATE( vg_cosmo(cosmo_grid %nz) )378 379 IF ( cfg %ug_defined_by_user ) THEN380 ug_palm = cfg %ug381 vg_palm = cfg %vg427 ALLOCATE( ug_palm(output_var%grid%nz) ) 428 ALLOCATE( vg_palm(output_var%grid%nz) ) 429 ALLOCATE( ug_cosmo(cosmo_grid%nz) ) 430 ALLOCATE( vg_cosmo(cosmo_grid%nz) ) 431 432 IF ( cfg%ug_defined_by_user ) THEN 433 ug_palm = cfg%ug 434 vg_palm = cfg%vg 382 435 ELSE 383 436 CALL geostrophic_winds( p_north, p_south, p_east, & … … 390 443 391 444 CALL interpolate_1d( ug_cosmo, ug_palm, & 392 output_var %grid )445 output_var%grid ) 393 446 394 447 CALL interpolate_1d( vg_cosmo, vg_palm, & 395 output_var %grid )448 output_var%grid ) 396 449 ENDIF 397 450 … … 402 455 ! 403 456 !-- Select output array of current geostrophic wind component 404 SELECT CASE( TRIM(output_var % name))405 CASE ( 'ls_forcing_ug')457 SELECT CASE( TRIM( output_var%name ) ) 458 CASE ( 'ls_forcing_ug' ) 406 459 ug_vg_palm => ug_palm 407 CASE ( 'ls_forcing_vg')460 CASE ( 'ls_forcing_vg' ) 408 461 ug_vg_palm => vg_palm 409 462 END SELECT 410 463 411 ALLOCATE( output_arr(1,1,output_var % grid %nz) )464 ALLOCATE( output_arr(1,1,output_var%grid%nz) ) 412 465 output_arr(1,1,:) = ug_vg_palm(:) 413 466 414 CASE ( 'average scalar' ) 415 416 ALLOCATE( output_arr(1,1,1) ) 417 CALL run_control('time', 'alloc') 418 output_arr(1,1,1) = p0 419 CALL run_control('time', 'comp') 420 467 !-- User defined constant profiles 421 468 CASE ( 'set profile' ) 422 469 423 ALLOCATE( output_arr( 1, 1, 1:nz) )424 CALL run_control('time', 'alloc')425 426 SELECT CASE ( TRIM(output_var % name))427 428 CASE ('nudging_tau')470 ALLOCATE( output_arr(1,1,1:nz) ) 471 CALL log_runtime( 'time', 'alloc' ) 472 473 SELECT CASE ( TRIM( output_var%name ) ) 474 475 CASE ( 'nudging_tau' ) 429 476 output_arr(1, 1, :) = NUDGING_TAU 430 477 431 478 CASE DEFAULT 432 message = "'" // TRIM( output_var % name) // &433 "' is not a valid '" // TRIM( output_var % kind) //&479 message = "'" // TRIM( output_var%name ) // & 480 "' is not a valid '" // TRIM( output_var%kind ) //& 434 481 "' variable kind." 435 CALL inifor_abort( 'main loop', message)482 CALL inifor_abort( 'main loop', message ) 436 483 END SELECT 437 CALL run_control('time', 'comp') 438 439 CASE('average large-scale profile') 440 message = "Averaging of large-scale forcing profiles " //& 441 "has not been implemented, yet." 442 CALL inifor_abort('main loop', message) 484 CALL log_runtime( 'time', 'comp' ) 443 485 444 486 CASE DEFAULT 445 message = "Processing task '" // TRIM( output_var % task) //&487 message = "Processing task '" // TRIM( output_var%task ) //& 446 488 "' not recognized." 447 CALL inifor_abort( '', message)489 CALL inifor_abort( '', message ) 448 490 449 491 END SELECT 450 CALL run_control('time', 'comp')492 CALL log_runtime( 'time', 'comp' ) 451 493 452 494 !------------------------------------------------------------------------------ … … 458 500 !-- defined on averaged COSMO levels instead of PALM levels 459 501 !-- (requires definiton of COSMO levels in netCDF output.) 460 !IF (.NOT. output_var %is_internal .OR. debugging_output) THEN461 462 IF ( .NOT. output_var % is_internal) THEN463 message = "Writing variable '" // TRIM( output_var%name) // "'."464 CALL report( 'main loop', message)465 CALL update_output( output_var, output_arr, iter,&466 output_file, cfg)467 CALL run_control('time', 'write')502 !IF (.NOT. output_var%is_internal .OR. debugging_output) THEN 503 504 IF ( .NOT. output_var%is_internal ) THEN 505 message = "Writing variable '" // TRIM( output_var%name ) // "'." 506 CALL report( 'main loop', message ) 507 CALL update_output( output_var, output_arr, iter, & 508 output_file, cfg ) 509 CALL log_runtime( 'time', 'write' ) 468 510 ENDIF 469 511 470 IF ( ALLOCATED(output_arr)) DEALLOCATE(output_arr)471 CALL run_control('time', 'alloc')512 IF ( ALLOCATED( output_arr ) ) DEALLOCATE( output_arr ) 513 CALL log_runtime( 'time', 'alloc' ) 472 514 473 515 ENDIF … … 478 520 479 521 ug_vg_have_been_computed = .FALSE. 480 IF ( group %kind == 'thermodynamics' ) THEN522 IF ( group%kind == 'thermodynamics' ) THEN 481 523 DEALLOCATE( rho_centre ) 482 524 DEALLOCATE( ug_palm ) … … 484 526 DEALLOCATE( ug_cosmo ) 485 527 DEALLOCATE( vg_cosmo ) 486 IF ( .NOT. cfg %ug_defined_by_user ) THEN528 IF ( .NOT. cfg%ug_defined_by_user ) THEN 487 529 DEALLOCATE( rho_north ) 488 530 DEALLOCATE( rho_south ) … … 499 541 !-- Keep input buffer around for averaged (radiation) and 500 542 !-- accumulated COSMO quantities (precipitation). 501 IF ( group %kind == 'running average' .OR. &502 group %kind == 'accumulated' ) THEN543 IF ( group%kind == 'running average' .OR. & 544 group%kind == 'accumulated' ) THEN 503 545 ELSE 504 CALL report( 'main loop', 'Deallocating input buffer', cfg % debug)505 DEALLOCATE( input_buffer)546 CALL report( 'main loop', 'Deallocating input buffer', cfg%debug ) 547 DEALLOCATE( input_buffer ) 506 548 ENDIF 507 CALL run_control('time', 'alloc')549 CALL log_runtime( 'time', 'alloc' ) 508 550 509 551 ! … … 511 553 ENDDO 512 554 513 IF ( ALLOCATED(input_buffer)) THEN514 CALL report( 'main loop', 'Deallocating input buffer', cfg % debug)515 DEALLOCATE( input_buffer)555 IF ( ALLOCATED( input_buffer ) ) THEN 556 CALL report( 'main loop', 'Deallocating input buffer', cfg%debug ) 557 DEALLOCATE( input_buffer ) 516 558 ENDIF 517 CALL run_control('time', 'alloc')559 CALL log_runtime( 'time', 'alloc' ) 518 560 519 561 ELSE 520 562 521 message = "Skipping IO group " // TRIM( str(igroup)) // " '" // TRIM(group % kind) // "'"522 IF ( ALLOCATED( group % in_var_list) ) THEN523 message = TRIM( message) // " with input variable '" //&524 TRIM( group % in_var_list(1) % name) // "'."563 message = "Skipping IO group " // TRIM( str( igroup ) ) // " '" // TRIM( group%kind ) // "'" 564 IF ( ALLOCATED( group%in_var_list ) ) THEN 565 message = TRIM( message ) // " with input variable '" // & 566 TRIM( group%in_var_list(1)%name ) // "'." 525 567 ENDIF 526 568 527 CALL report( 'main loop', message, cfg % debug)528 529 ! 530 !-- IO group %to_be_processed conditional569 CALL report( 'main loop', message, cfg%debug ) 570 571 ! 572 !-- IO group%to_be_processed conditional 531 573 ENDIF 532 574 … … 538 580 !- Section 3: Clean up. 539 581 !------------------------------------------------------------------------------ 540 CALL fini_file_lists ()541 CALL fini_io_groups ()542 CALL fini_variables ()543 !CALL fini_grids ()544 CALL run_control('time', 'alloc')545 CALL run_control('report', 'void')546 547 message = "Finished writing dynamic driver '" // TRIM( output_file % name) // &582 CALL fini_file_lists 583 CALL fini_io_groups 584 CALL fini_variables 585 !CALL fini_grids 586 CALL log_runtime( 'time', 'alloc' ) 587 CALL log_runtime( 'report', 'void' ) 588 589 message = "Finished writing dynamic driver '" // TRIM( output_file%name ) // & 548 590 "' successfully." 549 CALL report('main loop', message) 550 551 591 CALL report( 'main loop', message ) 592 CALL close_log 593 594 #else 595 596 USE inifor_control 597 IMPLICIT NONE 598 599 message = "INIFOR was compiled without netCDF support, which is required for it to run. " // & 600 "To use INIFOR, recompile PALM with netCDF support by adding the -D__netcdf " // & 601 "precompiler flag to your .palm.config file." 602 CALL inifor_abort( 'main loop', message ) 603 552 604 #endif 605 553 606 END PROGRAM inifor
Note: See TracChangeset
for help on using the changeset viewer.
