| 1 | !> @file src/inifor.f90 |
|---|
| 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-2018 Leibniz Universitaet Hannover |
|---|
| 18 | ! Copyright 2017-2018 Deutscher Wetterdienst Offenbach |
|---|
| 19 | !------------------------------------------------------------------------------! |
|---|
| 20 | ! |
|---|
| 21 | ! Current revisions: |
|---|
| 22 | ! ----------------- |
|---|
| 23 | ! |
|---|
| 24 | ! |
|---|
| 25 | ! Former revisions: |
|---|
| 26 | ! ----------------- |
|---|
| 27 | ! $Id: inifor.f90 3183 2018-07-27 14:25:55Z suehring $ |
|---|
| 28 | ! Introduced new PALM grid stretching |
|---|
| 29 | ! Renamend initial-condition mode variable 'mode' to 'ic_mode' |
|---|
| 30 | ! Improved log messages |
|---|
| 31 | ! |
|---|
| 32 | ! |
|---|
| 33 | ! 3182 2018-07-27 13:36:03Z suehring |
|---|
| 34 | ! Initial revision |
|---|
| 35 | ! |
|---|
| 36 | ! |
|---|
| 37 | ! |
|---|
| 38 | ! Authors: |
|---|
| 39 | ! -------- |
|---|
| 40 | ! @author Eckhard Kadasch |
|---|
| 41 | ! |
|---|
| 42 | ! Description: |
|---|
| 43 | ! ------------ |
|---|
| 44 | !> INIFOR is an interpolation tool for generating meteorological initialization |
|---|
| 45 | !> and forcing data for the urban climate model PALM-4U. The required |
|---|
| 46 | !> meteorological fields are interpolated from output data of the mesoscale |
|---|
| 47 | !> model COSMO-DE. This is the main program file. |
|---|
| 48 | !------------------------------------------------------------------------------! |
|---|
| 49 | PROGRAM inifor |
|---|
| 50 | |
|---|
| 51 | USE control |
|---|
| 52 | USE defs |
|---|
| 53 | USE grid, & |
|---|
| 54 | ONLY: setup_parameters, setup_grids, setup_variable_tables, & |
|---|
| 55 | setup_io_groups, fini_grids, fini_variables, fini_io_groups, & |
|---|
| 56 | fini_file_lists, preprocess, origin_lon, origin_lat, & |
|---|
| 57 | output_file, io_group_list, output_var_table, & |
|---|
| 58 | cosmo_grid, palm_grid, nx, ny, nz, ug, vg, p0, cfg, & |
|---|
| 59 | average_imin, average_imax, average_jmin, average_jmax |
|---|
| 60 | |
|---|
| 61 | USE io |
|---|
| 62 | USE transform, & |
|---|
| 63 | ONLY: average_profile, average_2d, interpolate_2d, interpolate_3d |
|---|
| 64 | USE types |
|---|
| 65 | |
|---|
| 66 | IMPLICIT NONE |
|---|
| 67 | |
|---|
| 68 | INTEGER :: igroup |
|---|
| 69 | INTEGER :: ivar |
|---|
| 70 | INTEGER :: iter |
|---|
| 71 | REAL(dp), ALLOCATABLE, DIMENSION(:,:,:) :: output_arr |
|---|
| 72 | TYPE(nc_var), POINTER :: output_var |
|---|
| 73 | TYPE(io_group), POINTER :: group |
|---|
| 74 | TYPE(container), ALLOCATABLE :: input_buffer(:) |
|---|
| 75 | |
|---|
| 76 | !> \mainpage About INIFOR |
|---|
| 77 | !> ... |
|---|
| 78 | ! |
|---|
| 79 | !------------------------------------------------------------------------------ |
|---|
| 80 | !- Section 1: Initialization |
|---|
| 81 | !------------------------------------------------------------------------------ |
|---|
| 82 | CALL run_control('init', 'void') |
|---|
| 83 | |
|---|
| 84 | ! Initialize INIFOR's parameters from command-line interface and namelists |
|---|
| 85 | CALL setup_parameters() |
|---|
| 86 | |
|---|
| 87 | ! Initialize all grids, including interpolation neighbours and weights |
|---|
| 88 | CALL setup_grids() |
|---|
| 89 | CALL run_control('time', 'init') |
|---|
| 90 | |
|---|
| 91 | ! Initialize the netCDF output file and define dimensions |
|---|
| 92 | CALL setup_netcdf_dimensions(output_file, palm_grid, cfg % start_date, & |
|---|
| 93 | origin_lon, origin_lat) |
|---|
| 94 | CALL run_control('time', 'write') |
|---|
| 95 | |
|---|
| 96 | ! Set up the tables containing the input and output variables and set |
|---|
| 97 | ! the corresponding netCDF dimensions for each output variable |
|---|
| 98 | CALL setup_variable_tables(cfg % ic_mode) |
|---|
| 99 | CALL run_control('time', 'write') |
|---|
| 100 | |
|---|
| 101 | ! Add the output variables to the netCDF output file |
|---|
| 102 | CALL setup_netcdf_variables(output_file % name, output_var_table) |
|---|
| 103 | |
|---|
| 104 | CALL setup_io_groups() |
|---|
| 105 | CALL run_control('time', 'init') |
|---|
| 106 | |
|---|
| 107 | !------------------------------------------------------------------------------ |
|---|
| 108 | !- Section 2: Main loop |
|---|
| 109 | !------------------------------------------------------------------------------ |
|---|
| 110 | |
|---|
| 111 | DO igroup = 1, SIZE(io_group_list) |
|---|
| 112 | |
|---|
| 113 | group => io_group_list(igroup) |
|---|
| 114 | IF ( group % to_be_processed ) THEN |
|---|
| 115 | |
|---|
| 116 | DO iter = 1, group % nt |
|---|
| 117 | |
|---|
| 118 | !------------------------------------------------------------------------------ |
|---|
| 119 | !- Section 2.1: Read and preprocess input data |
|---|
| 120 | !------------------------------------------------------------------------------ |
|---|
| 121 | CALL read_input_variables(group, iter, input_buffer) |
|---|
| 122 | CALL run_control('time', 'read') |
|---|
| 123 | |
|---|
| 124 | CALL preprocess(group, input_buffer, cosmo_grid, iter) |
|---|
| 125 | CALL run_control('time', 'comp') |
|---|
| 126 | |
|---|
| 127 | !TODO: move this assertion into 'preprocess'. |
|---|
| 128 | IF ( .NOT. ALL(input_buffer(:) % is_preprocessed .AND. .TRUE.) ) THEN |
|---|
| 129 | message = "Input buffers for group '" // TRIM(group % kind) // & |
|---|
| 130 | "' could not be preprocessed sucessfully." |
|---|
| 131 | CALL abort('main loop', message) |
|---|
| 132 | END IF |
|---|
| 133 | |
|---|
| 134 | !------------------------------------------------------------------------------ |
|---|
| 135 | !- Section 2.2: Interpolate each output variable of the group |
|---|
| 136 | !------------------------------------------------------------------------------ |
|---|
| 137 | DO ivar = 1, group % nv |
|---|
| 138 | |
|---|
| 139 | output_var => group % out_vars( ivar ) |
|---|
| 140 | |
|---|
| 141 | IF ( output_var % to_be_processed .AND. & |
|---|
| 142 | iter .LE. output_var % nt ) THEN |
|---|
| 143 | |
|---|
| 144 | message = "Processing '" // TRIM(output_var % name) // & |
|---|
| 145 | "' (" // TRIM(output_var % kind) // & |
|---|
| 146 | "), iteration " // TRIM(str(iter)) //" of " // & |
|---|
| 147 | TRIM(str(output_var % nt)) |
|---|
| 148 | CALL report('main loop', message) |
|---|
| 149 | |
|---|
| 150 | SELECT CASE( TRIM(output_var % task) ) |
|---|
| 151 | |
|---|
| 152 | CASE( 'interpolate_2d' ) |
|---|
| 153 | |
|---|
| 154 | SELECT CASE( TRIM(output_var % kind) ) |
|---|
| 155 | |
|---|
| 156 | CASE( 'init soil' ) |
|---|
| 157 | |
|---|
| 158 | ALLOCATE( output_arr( 0:output_var % grid % nx, & |
|---|
| 159 | 0:output_var % grid % ny, & |
|---|
| 160 | SIZE(output_var % grid % depths) ) ) |
|---|
| 161 | |
|---|
| 162 | CASE ( 'surface forcing' ) |
|---|
| 163 | |
|---|
| 164 | ALLOCATE( output_arr( 0:output_var % grid % nx, & |
|---|
| 165 | 0:output_var % grid % ny, 1 ) ) |
|---|
| 166 | |
|---|
| 167 | CASE DEFAULT |
|---|
| 168 | |
|---|
| 169 | message = "'" // TRIM(output_var % kind) // "' is not a soil variable" |
|---|
| 170 | CALL abort("main loop", message) |
|---|
| 171 | |
|---|
| 172 | END SELECT |
|---|
| 173 | CALL run_control('time', 'alloc') |
|---|
| 174 | |
|---|
| 175 | CALL interpolate_2d(input_buffer(output_var % input_id) % array(:,:,:), & |
|---|
| 176 | output_arr(:,:,:), output_var % intermediate_grid, output_var) |
|---|
| 177 | CALL run_control('time', 'comp') |
|---|
| 178 | |
|---|
| 179 | |
|---|
| 180 | CASE ( 'interpolate_3d' ) |
|---|
| 181 | |
|---|
| 182 | ALLOCATE( output_arr( 0:output_var % grid % nx, & |
|---|
| 183 | 0:output_var % grid % ny, & |
|---|
| 184 | 1:output_var % grid % nz ) ) |
|---|
| 185 | |
|---|
| 186 | CALL run_control('time', 'alloc') |
|---|
| 187 | CALL interpolate_3d( & |
|---|
| 188 | input_buffer(output_var % input_id) % array(:,:,:), & |
|---|
| 189 | output_arr(:,:,:), & |
|---|
| 190 | output_var % intermediate_grid, & |
|---|
| 191 | output_var % grid) |
|---|
| 192 | CALL run_control('time', 'comp') |
|---|
| 193 | |
|---|
| 194 | CASE ( 'average profile' ) |
|---|
| 195 | |
|---|
| 196 | ALLOCATE( output_arr( 0:output_var % grid % nx, & |
|---|
| 197 | 0:output_var % grid % ny, & |
|---|
| 198 | 1:output_var % grid % nz ) ) |
|---|
| 199 | CALL run_control('time', 'alloc') |
|---|
| 200 | |
|---|
| 201 | |
|---|
| 202 | CALL average_profile( & |
|---|
| 203 | input_buffer(output_var % input_id) % array(:,:,:), & |
|---|
| 204 | output_arr(:,:,:), average_imin, average_imax, & |
|---|
| 205 | average_jmin, average_jmax, & |
|---|
| 206 | output_var % intermediate_grid, & |
|---|
| 207 | output_var % grid) |
|---|
| 208 | CALL run_control('time', 'comp') |
|---|
| 209 | |
|---|
| 210 | CASE ( 'average scalar' ) |
|---|
| 211 | |
|---|
| 212 | ALLOCATE( output_arr(1,1,1) ) |
|---|
| 213 | CALL run_control('time', 'alloc') |
|---|
| 214 | output_arr(1,1,1) = p0 |
|---|
| 215 | CALL run_control('time', 'comp') |
|---|
| 216 | |
|---|
| 217 | CASE ( 'set profile' ) |
|---|
| 218 | |
|---|
| 219 | ALLOCATE( output_arr( 1, 1, 1:nz ) ) |
|---|
| 220 | CALL run_control('time', 'alloc') |
|---|
| 221 | |
|---|
| 222 | SELECT CASE (TRIM(output_var % name)) |
|---|
| 223 | |
|---|
| 224 | CASE('ls_forcing_ug') |
|---|
| 225 | output_arr(1, 1, :) = ug |
|---|
| 226 | |
|---|
| 227 | CASE('ls_forcing_vg') |
|---|
| 228 | output_arr(1, 1, :) = vg |
|---|
| 229 | |
|---|
| 230 | CASE('nudging_tau') |
|---|
| 231 | output_arr(1, 1, :) = NUDGING_TAU |
|---|
| 232 | |
|---|
| 233 | CASE DEFAULT |
|---|
| 234 | message = "'" // TRIM(output_var % name) // & |
|---|
| 235 | "' is not a valid '" // TRIM(output_var % kind) //& |
|---|
| 236 | "' variable kind." |
|---|
| 237 | CALL abort('main loop', message) |
|---|
| 238 | END SELECT |
|---|
| 239 | CALL run_control('time', 'comp') |
|---|
| 240 | |
|---|
| 241 | CASE('average large-scale profile') |
|---|
| 242 | message = "Averaging of large-scale forcing profiles " //& |
|---|
| 243 | "has not been implemented, yet." |
|---|
| 244 | CALL abort('main loop', message) |
|---|
| 245 | !ALLOCATE( output_arr( 1, 1, 1:nz ) ) |
|---|
| 246 | |
|---|
| 247 | CASE DEFAULT |
|---|
| 248 | message = "Processing task '" // TRIM(output_var % task) //& |
|---|
| 249 | "' not recognized." |
|---|
| 250 | CALL abort('', message) |
|---|
| 251 | |
|---|
| 252 | END SELECT |
|---|
| 253 | CALL run_control('time', 'comp') |
|---|
| 254 | |
|---|
| 255 | !------------------------------------------------------------------------------ |
|---|
| 256 | !- Section 2.3: Write current time step of current variable |
|---|
| 257 | !------------------------------------------------------------------------------ |
|---|
| 258 | message = "Writing variable '" // TRIM(output_var%name) // "'." |
|---|
| 259 | CALL report('main loop', message) |
|---|
| 260 | CALL update_output(output_var, output_arr, iter, output_file) |
|---|
| 261 | CALL run_control('time', 'write') |
|---|
| 262 | |
|---|
| 263 | DEALLOCATE(output_arr) |
|---|
| 264 | CALL run_control('time', 'alloc') |
|---|
| 265 | |
|---|
| 266 | END IF |
|---|
| 267 | |
|---|
| 268 | END DO ! ouput variables |
|---|
| 269 | |
|---|
| 270 | IF ( group % kind == 'running average' .OR. & |
|---|
| 271 | group % kind == 'accumulated' ) THEN |
|---|
| 272 | ! Keep input buffer around for averaged (radiation) and |
|---|
| 273 | ! accumulated COSMO-DE quantities (precipitation). |
|---|
| 274 | ELSE |
|---|
| 275 | CALL report('main loop', 'Deallocating input buffer') |
|---|
| 276 | DEALLOCATE(input_buffer) |
|---|
| 277 | END IF |
|---|
| 278 | CALL run_control('time', 'alloc') |
|---|
| 279 | |
|---|
| 280 | END DO ! time steps / input files |
|---|
| 281 | |
|---|
| 282 | IF (ALLOCATED(input_buffer)) THEN |
|---|
| 283 | CALL report('main loop', 'Deallocating input buffer') |
|---|
| 284 | DEALLOCATE(input_buffer) |
|---|
| 285 | END IF |
|---|
| 286 | CALL run_control('time', 'alloc') |
|---|
| 287 | |
|---|
| 288 | ELSE |
|---|
| 289 | |
|---|
| 290 | message = "Skipping IO group " // TRIM(str(igroup)) // " '" // TRIM(group % kind) // "'" |
|---|
| 291 | IF ( ALLOCATED(group % in_var_list) ) THEN |
|---|
| 292 | message = TRIM(message) // " with input variable '" // & |
|---|
| 293 | TRIM(group % in_var_list(1) % name) // "'." |
|---|
| 294 | END IF |
|---|
| 295 | |
|---|
| 296 | CALL report('main loop', message) |
|---|
| 297 | |
|---|
| 298 | END IF ! IO group % to_be_processed |
|---|
| 299 | |
|---|
| 300 | END DO ! IO groups |
|---|
| 301 | |
|---|
| 302 | !------------------------------------------------------------------------------ |
|---|
| 303 | !- Section 3: Clean up. |
|---|
| 304 | !------------------------------------------------------------------------------ |
|---|
| 305 | CALL fini_file_lists() |
|---|
| 306 | CALL fini_io_groups() |
|---|
| 307 | CALL fini_variables() |
|---|
| 308 | !CALL fini_grids() |
|---|
| 309 | CALL run_control('time', 'alloc') |
|---|
| 310 | CALL run_control('report', 'void') |
|---|
| 311 | |
|---|
| 312 | message = "Finished writing dynamic driver '" // TRIM(output_file % name) // & |
|---|
| 313 | "' successfully." |
|---|
| 314 | CALL report('main loop', message) |
|---|
| 315 | |
|---|
| 316 | |
|---|
| 317 | END PROGRAM inifor |
|---|
