standalone/wrf_netcdf.F

   1 !    files and reads input files that are somewhat compatible with wrf files
   2 !
   3
   4 module wrf_netcdf
   5 use netcdf
   6 use module_fr_sfire_util , only : crash, interpolate_2d, continue_at_boundary
   7 use module_domain, only: domain
   8 implicit none
   9
  10 ! default file names
  11 character(len=*),parameter::inputfile='fire_input.nc'
  12 character(len=*),parameter::outputfile='fire_output.nc'
  13
  14 ! control whether the dimensions of the fire grid variables should have
  15 ! the same (incorrect) sizes that wrf outputs and same dimension names
  16 !
  17 logical::compat_fire_grid=.true.
  18 logical::debug_print=.false.
  19 logical::debug_print_f=.true.
  20 logical::read_check=.false.
  21
  22 ! output variable type
  23 integer,parameter::vartype=nf90_float,field_type=104
  24
  25 ! max number of dimensions
  26 integer, parameter:: mdims=4
  27
  28 ! variable names
  29 character(len=nf90_max_name)::                        &
  30                               var_xtime='XTIME',        &
  31                               unit_xtime='min',                &
  32                               desc_xtime='minutes since simulation start',                &
  33                               var_itimestep='ITIMESTEP',        &
  34                               unit_itimestep='',                &
  35                               desc_itimestep='',                &
  36                               var_nfuel_cat='NFUEL_CAT',        &
  37                               unit_nfuel_cat='',                &
  38                               desc_nfuel_cat='',                &
  39                               var_dzdxf='DZDXF',                &
  40                               unit_dzdxf='',                    &
  41                               desc_dzdxf='',                    &
  42                               var_dzdyf='DZDYF',                &
  43                               unit_dzdyf='',                    &
  44                               desc_dzdyf='',                    &
  45                               var_zsf='ZSF',                    &
  46                               unit_zsf='',                      &
  47                               desc_zsf='',                      &
  48                               var_lfn='LFN',                    &
  49                               unit_lfn='',                      &
  50                               desc_lfn='',                      &
  51                               var_tign_g='TIGN_G',              &
  52                               unit_tign_g='',                   &
  53                               desc_tign_g='',                   &
  54                               var_tign_in='TIGN_IN',            &
  55                               unit_tign_in='',                  &
  56                               desc_tign_in='',                  &
  57                               var_fmc_g='FMC_G',                &
  58                               unit_fmc_g='',                    &
  59                               desc_fmc_g='',                    &
  60                               var_fmc_gc='FMC_GC',              &
  61                               unit_fmc_gc='',                   &
  62                               desc_fmc_gc='',                   &
  63                               var_fxlong='FXLONG',              &
  64                               unit_fxlong='',                   &
  65                               desc_fxlong='',                   &
  66                               var_fxlat='FXLAT',                &
  67                               unit_fxlat='',                    &
  68                               desc_fxlat='',                    &
  69                               var_unit_fxlong='UNIT_FXLONG',    &
  70                               unit_unit_fxlong='',              &
  71                               desc_unit_fxlong='',              &
  72                               var_unit_fxlat='UNIT_FXLAT',      &
  73                               unit_unit_fxlat='',               &
  74                               desc_unit_fxlat='',               &
  75                               var_uf='UF',                      &
  76                               unit_uf='',                       &
  77                               desc_uf='',                       &
  78                               var_vf='VF',                      &
  79                               unit_vf='',                       &
  80                               desc_vf='',                       &
  81                               var_fuel_frac='FUEL_FRAC',        &
  82                               unit_fuel_frac='',                &
  83                               desc_fuel_frac='',                &
  84                               var_fire_area='FIRE_AREA',        &
  85                               unit_fire_area='',                &
  86                               desc_fire_area='',                &
  87                               var_fgrnhfx='FGRNHFX',            &
  88                               unit_fgrnhfx='',                  &
  89                               desc_fgrnhfx='',                  &
  90                               var_fgrnqfx='FGRNQFX',            &
  91                               unit_fgrnqfx='J/m^2',             &
  92                               desc_fgrnqfx='heat flux',         &
  93                               var_ros='ROS',                    &
  94                               unit_ros='m/s',                   &
  95                               desc_ros='ROS',                   &
  96                               var_r_0='R_0',                    &
  97                               unit_r_0='m/s',                   &
  98                               desc_r_0='R_0',                   &
  99                               var_flineint='FLINEINT',          &
 100                               unit_flineint='J/m/s',            &
 101                               desc_flineint='Byram fireline intensity',         &
 102                               var_flineint2='FLINEINT2',        &
 103                               unit_flineint2='J/m/s^2',         &
 104                               desc_flineint2='New fireline intensity' , &
 105                               var_f_ros0='F_ROS0',          &
 106                               unit_f_ros0='m/s',            &
 107                               desc_f_ros0='base rate of spread in all directions',  &
 108                               var_f_rosx='F_ROSX',          &
 109                               unit_f_rosx='m/s',            &
 110                               desc_f_rosx='potential rate of spread in direction X',  &
 111                               var_f_rosy='F_ROSY',          &
 112                               unit_f_rosy='m/s',            &
 113                               desc_f_rosy='potential rate of spread in direction Y',  &
 114                               var_f_ros='F_ROS',          &
 115                               unit_f_ros='m/s',            &
 116                               desc_f_ros='potential fire max spread rate in any direction',  &
 117                               var_f_int='F_INT',          &
 118                               unit_f_int='J/m^2/s',            &
 119                               desc_f_int='potential fire reaction intensity for risk rating',  &
 120                               var_f_lineint='F_LINEINT',          &
 121                               unit_f_lineint='J/m/s',            &
 122                               desc_f_lineint='potential Byram fireline intensity for risk rating',  &
 123                               var_f_lineint2='F_LINEINT2',          &
 124                               unit_f_lineint2='J/m/s^2',            &
 125                               desc_f_lineint2='potential alternative fireline intensity for risk rating'
 126
 127 character(len=nf90_max_name),parameter::var_times='Times'
 128
 129 ! grid information structure
 130 integer, parameter::max_times_length=19
 131 type grid_info
 132   integer::nfirex,nfirey,      & ! fire grid size
 133            ntimes                ! number of time frames
 134   real::fdx,fdy,dt               ! mesh and time resolution
 135   character(len=max_times_length)::times ! the time string from the file
 136   integer::len_time_string     ! length of the times string
 137   character(len=nf90_max_name)::      &
 138     dim_time_string='DateStrLen',     &
 139     dim_fire_x='west_east_subgrid',   &
 140     dim_fire_y='south_north_subgrid', &
 141     dim_time='Time'
 142   integer::io_nfirex,io_nfirey        ! fire grid size in files
 143   ! WRF compatibility
 144   integer :: sr_x,sr_y           ! refinement ratios
 145   integer :: nstagx,nstagy
 146   character(len=nf90_max_name)::      &
 147     dim_atm_x='west_east',            &
 148     dim_atm_y='south_north',          &
 149     dim_atm_z='bottom_top',           &
 150     dim_atm_x_s='west_east_stag',     &
 151     dim_atm_y_s='south_north_stag',   &
 152     dim_atm_z_s='bottom_top_stag'
 153 end type
 154
 155 contains
 156
 157 subroutine create_dim_attr(filename,info)
 158
 159 ! Create an empty NetCDF file with proper dimension names
 160 ! (a.k.a. attributes) defined.
 161
 162 implicit none
 163
 164 !*** arguments
 165 character(len=*),intent(in)::filename  ! filename to create
 166 type(grid_info),intent(in)::info       ! grid information structure
 167
 168 !*** local
 169 integer::ncid,dimid,timeid,strlenid,varid
 170
 171 !*** executable
 172
 173 ! create an empty file
 174 call check(nf90_create(filename,nf90_clobber,ncid))
 175
 176 ! define all dimensions
 177
 178 call create_dim(ncid,info%dim_time,nf90_unlimited)
 179 call create_dim(ncid,info%dim_fire_x,info%io_nfirex)
 180 call create_dim(ncid,info%dim_fire_y,info%io_nfirey)
 181 call create_dim(ncid,info%dim_time_string,info%len_time_string)
 182 if (compat_fire_grid)then
 183   call create_dim(ncid,info%dim_atm_x_s,info%nstagx)
 184   call create_dim(ncid,info%dim_atm_y_s,info%nstagy)
 185 endif
 186
 187 ! define global attributes
 188 call check(nf90_put_att(ncid,nf90_global,'DX',info%fdx*info%sr_x))
 189 call check(nf90_put_att(ncid,nf90_global,'DY',info%fdy*info%sr_y))
 190 call check(nf90_put_att(ncid,nf90_global,'FDX',info%fdx))
 191 call check(nf90_put_att(ncid,nf90_global,'FDY',info%fdy))
 192 call check(nf90_put_att(ncid,nf90_global,'DT',info%dt))
 193 call check(nf90_put_att(ncid,nf90_global,'STANDALONE_DRIVER',1))
 194
 195 call check(nf90_enddef(ncid))
 196 call check(nf90_close(ncid))
 197
 198 end subroutine create_dim_attr
 199
 200 subroutine create_dim(ncid,dimname,dimsize)
 201 integer, intent(in):: ncid
 202 character(len=*),intent(in)::dimname  ! dimension name to create
 203 integer, intent(in):: dimsize
 204 integer::dimid
 205
 206 !!The function NF90_DEF_DIM adds a new dimension to an open netCDF dataset in
 207 !!define mode. It returns (as an argument) a dimension ID, given the netCDF ID,
 208 !!the dimension name, and the dimension length. (From NetCDF docs)
 209
 210 if(debug_print)write(*,'(3a,i10)')'creating dimension ',trim(dimname),' size',dimsize
 211 call check(nf90_def_dim(ncid,dimname,dimsize,dimid))
 212 end subroutine create_dim
 213
 214 !
 215 !***
 216 !
 217
 218 subroutine create_output_file(filename,info)
 219
 220 !*** Create a file containing meta-data suitable for output of this simulation.
 221 !    Only creates dimensions, variables, and attributes... does not populate
 222 !    data.  Squash file if it already exists.
 223
 224 implicit none
 225
 226 !*** arguments
 227 character(len=*),intent(in)::filename  ! filename to create
 228 type(grid_info),intent(in)::info       ! grid information structure
 229
 230 !*** local
 231 integer::ncid,dimid,timeid,strlenid,varid
 232 character(len=NF90_MAX_NAME), dimension(3)::dim_fire
 233
 234 !*** executable
 235
 236 call create_dim_attr(filename,info)
 237
 238 call ncopen(filename,nf90_write,ncid)
 239 call check(nf90_inq_dimid(ncid,info%dim_time_string,strlenid))
 240 call check(nf90_inq_dimid(ncid,info%dim_time,timeid))
 241
 242 call check(nf90_redef(ncid))
 243 ! define a timekeeping variable
 244 call check(nf90_def_var(ncid,var_times,nf90_char,(/strlenid,timeid/),varid))
 245 ! define scalar variables
 246 call check(nf90_def_var(ncid,var_unit_fxlong,nf90_float,(/timeid/),varid))
 247 call check(nf90_def_var(ncid,var_unit_fxlat,nf90_float,(/timeid/),varid))
 248 call check(nf90_def_var(ncid,var_xtime,nf90_float,(/timeid/),varid))
 249 call check(nf90_def_var(ncid,var_itimestep,nf90_int,(/timeid/),varid))
 250 call check(nf90_enddef(ncid))
 251 call check(nf90_close(ncid))
 252
 253 ! create all of the output variables
 254 dim_fire=(/info%dim_fire_x,info%dim_fire_y,info%dim_time/)
 255 call define_var(filename,info,var_zsf,3,dim_fire,unit_zsf,desc_zsf)
 256 call define_var(filename,info,var_dzdxf,3,dim_fire,unit_dzdxf,desc_dzdxf)
 257 call define_var(filename,info,var_dzdyf,3,dim_fire,unit_dzdyf,desc_dzdyf)
 258 call define_var(filename,info,var_nfuel_cat,3,dim_fire,unit_nfuel_cat,desc_nfuel_cat)
 259 call define_var(filename,info,var_uf,3,dim_fire,unit_uf,desc_uf)
 260 call define_var(filename,info,var_vf,3,dim_fire,unit_vf,desc_vf)
 261 call define_var(filename,info,var_fmc_g,3,dim_fire,unit_fmc_g,desc_fmc_g)
 262 call define_var(filename,info,var_lfn,3,dim_fire,unit_lfn,desc_lfn)
 263 call define_var(filename,info,var_tign_g,3,dim_fire,unit_tign_g,desc_tign_g)
 264 call define_var(filename,info,var_tign_in,3,dim_fire,unit_tign_in,desc_tign_in)
 265 call define_var(filename,info,var_fxlong,3,dim_fire,unit_fxlong,desc_fxlong)
 266 call define_var(filename,info,var_fxlat,3,dim_fire,unit_fxlat,desc_fxlat)
 267 call define_var(filename,info,var_fgrnhfx,3,dim_fire,unit_fgrnhfx,desc_fgrnhfx)
 268 call define_var(filename,info,var_fgrnqfx,3,dim_fire,unit_fgrnqfx,desc_fgrnqfx)
 269 call define_var(filename,info,var_fuel_frac,3,dim_fire,unit_fuel_frac,desc_fuel_frac)
 270 call define_var(filename,info,var_fire_area,3,dim_fire,unit_fire_area,desc_fire_area)
 271 call define_var(filename,info,var_flineint,3,dim_fire,unit_flineint,desc_flineint)
 272 call define_var(filename,info,var_flineint2,3,dim_fire,unit_flineint2,desc_flineint2)
 273 call define_var(filename,info,var_ros,3,dim_fire,unit_ros,desc_ros)
 274 call define_var(filename,info,var_r_0,3,dim_fire,unit_r_0,desc_r_0)
 275 call define_var(filename,info,var_f_ros0,3,dim_fire,unit_f_ros0,desc_f_ros0)
 276 call define_var(filename,info,var_f_rosx,3,dim_fire,unit_f_rosx,desc_f_rosx)
 277 call define_var(filename,info,var_f_rosy,3,dim_fire,unit_f_rosy,desc_f_rosy)
 278 call define_var(filename,info,var_f_ros,3,dim_fire,unit_f_ros,desc_f_ros)
 279 call define_var(filename,info,var_f_int,3,dim_fire,unit_f_int,desc_f_int)
 280 call define_var(filename,info,var_f_lineint,3,dim_fire,unit_f_lineint,desc_f_lineint)
 281 call define_var(filename,info,var_f_lineint2,3,dim_fire,unit_f_lineint2,desc_f_lineint2)
 282
 283 end subroutine create_output_file
 284
 285 !
 286 !***
 287 !
 288
 289 subroutine define_var(filename,info,varname,ndims,dims,units,description)
 290
 291 !*** define a variable in a netcdf data set, the file is assumed to exist and
 292 !    have valid meta-data (as created by create_output_file)
 293
 294 implicit none
 295
 296 !*** arguments
 297 character(len=*),intent(in)::filename,varname  ! create variable varname in filename
 298 type(grid_info), intent(in)::info
 299 integer, intent(in)::ndims
 300 character(len=NF90_MAX_NAME),intent(in)::dims(ndims) ! the dimension names of the variable
 301 character(len=*),intent(in) ::units,description ! attributes created by wrf
 302
 303 !*** local
 304 integer::ncid,i,varid
 305 integer,dimension(ndims)::dimids
 306 character(len=*),parameter::memorder='XYZ'
 307 character(len=3)::stag
 308
 309 !*** executable
 310 ! open the file
 311 call ncopen(filename,nf90_write,ncid)
 312
 313 ! get dimension id's
 314 do i=1,ndims
 315   call check(nf90_inq_dimid(ncid,dims(i),dimids(i)))
 316 enddo
 317
 318 ! enter define mode and define the variable
 319 call check(nf90_redef(ncid))
 320 call check(nf90_def_var(ncid,varname,vartype,dimids(1:size(dims)),varid))
 321
 322 ! add attributes
 323 call check(nf90_put_att(ncid,varid,'FieldType',field_type))
 324 call check(nf90_put_att(ncid,varid,'MemoryOrder',memorder(1:size(dims))))
 325 call check(nf90_put_att(ncid,varid,'description',description))
 326 call check(nf90_put_att(ncid,varid,'units',units))
 327 if(ndims.eq.3)then
 328   stag='Z'
 329 elseif(trim(dims(1)).eq.info%dim_atm_x_s)then
 330   stag='X'
 331 elseif(trim(dims(2)).eq.info%dim_atm_y_s)then
 332   stag='Y'
 333 elseif(trim(dims(3)).eq.info%dim_atm_z_s)then
 334   stag='Z'
 335 else
 336   stag=''
 337 endif
 338 call check(nf90_put_att(ncid,varid,'stagger',stag))
 339 call check(nf90_put_att(ncid,varid,'coordinates','XLONG XLAT'))
 340
 341 ! close file
 342 call check(nf90_enddef(ncid))
 343 call check(nf90_close(ncid))
 344 call print_var_info(filename,varname)  ! check
 345 end subroutine define_var
 346
 347 !
 348 !***
 349 !
 350
 351 subroutine write_vars(filename,grid,info,iframe)
 352 !*** append variables to an output file (extending by the unlimited time
 353 !    dimension)
 354 implicit none
 355
 356 !*** arguments
 357 character(len=*),intent(in)::filename
 358 type(domain),intent(inout)::grid      ! the mother of all arrays
 359 type(grid_info),intent(in)::info    ! dimensions
 360 integer, intent(in)::iframe         ! frame to write into
 361
 362 !*** local
 363 integer::ncid,dimid,varid
 364
 365 !*** executable
 366
 367 ! open the file
 368 call print_var_info(filename,var_lfn)
 369 call ncopen(filename,nf90_write,ncid)
 370
 371 if(debug_print_f)write(*,'(3a,i4,2a)')'write_vars: writing file ',trim(filename), &
 372    ' frame ',iframe,' time ',info%times
 373
 374 ! write out the current simulation time
 375 call check(nf90_inq_varid(ncid,var_times,varid),'cannot find '//trim(var_times))
 376 call check(nf90_put_var(ncid,varid,info%times,start=(/1,iframe/), &
 377      count=(/info%len_time_string,1/)), 'error writing '//trim(var_times))
 378
 379 call write_integer(ncid,iframe,var_itimestep,grid%itimestep)
 380 call write_real(ncid,iframe,var_xtime,grid%xtime)
 381 call write_fire_var(ncid,info,iframe,var_lfn,grid%lfn)
 382 call write_fire_var(ncid,info,iframe,var_tign_g,grid%tign_g)
 383 call write_fire_var(ncid,info,iframe,var_fxlong,grid%fxlong)
 384 call write_fire_var(ncid,info,iframe,var_fxlat,grid%fxlat)
 385 call write_fire_var(ncid,info,iframe,var_zsf,grid%zsf)
 386 call write_fire_var(ncid,info,iframe,var_fuel_frac,grid%fuel_frac)
 387 call write_fire_var(ncid,info,iframe,var_fire_area,grid%fire_area)
 388 call write_fire_var(ncid,info,iframe,var_fgrnhfx,grid%fgrnhfx)
 389 call write_fire_var(ncid,info,iframe,var_fgrnqfx,grid%fgrnqfx)
 390 call write_fire_var(ncid,info,iframe,var_ros,grid%ros)
 391 call write_fire_var(ncid,info,iframe,var_r_0,grid%r_0)
 392 call write_fire_var(ncid,info,iframe,var_flineint,grid%flineint)
 393 call write_fire_var(ncid,info,iframe,var_flineint2,grid%flineint2)
 394 call write_real(ncid,iframe,var_unit_fxlong,grid%unit_fxlong)
 395 call write_real(ncid,iframe,var_unit_fxlat,grid%unit_fxlat)
 396 call write_fire_var(ncid,info,iframe,var_uf,grid%uf)
 397 call write_fire_var(ncid,info,iframe,var_vf,grid%vf)
 398 call write_fire_var(ncid,info,iframe,var_f_ros0,grid%f_ros0)
 399 call write_fire_var(ncid,info,iframe,var_f_rosx,grid%f_rosx)
 400 call write_fire_var(ncid,info,iframe,var_f_rosy,grid%f_rosy)
 401 call write_fire_var(ncid,info,iframe,var_f_ros,grid%f_ros)
 402 call write_fire_var(ncid,info,iframe,var_f_int,grid%f_int)
 403 call write_fire_var(ncid,info,iframe,var_f_lineint,grid%f_lineint)
 404 call write_fire_var(ncid,info,iframe,var_f_lineint2,grid%f_lineint2)
 405
 406 ! close file
 407 call latch
 408 call check(nf90_close(ncid))
 409 call print_var_info(filename,var_lfn)
 410 end subroutine write_vars
 411
 412 subroutine write_inputs(filename,grid,info)
 413 implicit none
 414 character(len=*),intent(in)::filename
 415 type(domain),intent(in)::grid
 416 type(grid_info),intent(in)::info
 417
 418 integer::ncid,dimid,varid
 419
 420 call create_output_file(filename,info)
 421 call ncopen(filename,nf90_write,ncid)
 422
 423 ! write out the current simulation time
 424 call check(nf90_inq_varid(ncid,var_times,varid),'cannot find '//trim(var_times))
 425 call check(nf90_put_var(ncid,varid,info%times,start=(/1,1/), &
 426      count=(/info%len_time_string,1/)), 'error writing '//trim(var_times))
 427
 428 call write_fire_var(ncid,info,1,var_nfuel_cat,grid%nfuel_cat)
 429 call write_fire_var(ncid,info,1,var_dzdxf,grid%dzdxf)
 430 call write_fire_var(ncid,info,1,var_dzdyf,grid%dzdyf)
 431 call write_fire_var(ncid,info,1,var_zsf,grid%zsf)
 432 call write_fire_var(ncid,info,1,var_uf,grid%uf)
 433 call write_fire_var(ncid,info,1,var_vf,grid%vf)
 434 call write_fire_var(ncid,info,1,var_fmc_g,grid%fmc_g)
 435 call write_fire_var(ncid,info,1,var_fxlat,grid%fxlat)
 436 call write_fire_var(ncid,info,1,var_fxlong,grid%fxlong)
 437
 438 call latch
 439 call check(nf90_close(ncid))
 440 end subroutine write_inputs
 441
 442 !
 443 !*** READING
 444 !
 445
 446 subroutine read_info(filename,info)
 447 ! get fire grid sizes from input file
 448 implicit none
 449
 450 !*** arguments
 451 character(len=*),intent(in)::filename
 452 type(grid_info),intent(inout)::info
 453
 454 !*** local
 455 integer::ncid,it,ndims,idim,ratio,stagid,i
 456 integer,dimension(mdims)::dims,sr,dimids,stag
 457 real::dx,dy
 458 character(len=128)::msg
 459 character(len=NF90_MAX_NAME)::dimnames(mdims),dimname,stagname,stagnames(mdims)
 460 character(len=*), parameter:: subgrid='_subgrid'
 461
 462 !*** executable
 463
 464 ! get time string information
 465 call read_var_info(filename,var_times,ndims,dims,dimnames)
 466 if(ndims.ne.2)call crash(trim(var_times)//' must have 2 dimensions')
 467 info%dim_time_string = dimnames(1)
 468 info%len_time_string = dims(1)
 469 if(dims(1).gt.max_times_length)call crash('time string too long')
 470
 471 ! get dimensions
 472 call read_var_info(filename,var_nfuel_cat,ndims,dims,dimnames)
 473
 474 ! store in info what you can now
 475 info%io_nfirex=dims(1)
 476 info%io_nfirey=dims(2)
 477 info%ntimes=dims(3)
 478 info%dim_fire_x=dimnames(1)
 479 info%dim_fire_y=dimnames(2)
 480 info%dim_time=dimnames(3)
 481
 482 ! attributes
 483 call ncopen(filename,nf90_nowrite,ncid)
 484 call att_read(ncid,'DX',info%fdx)
 485 call att_read(ncid,'DY',info%fdy)
 486 call att_read(ncid,'DT',info%dt)
 487
 488 sr=0
 489 stag=0
 490 stagnames=' '
 491 if(compat_fire_grid)then
 492   do idim=1,2
 493     dimname=dimnames(idim)
 494     i=index(dimname,subgrid,.true.)
 495     if ( i + len(subgrid) .eq. len_trim(dimname)+1) then ! subgrid, need to fix
 496         stagname=dimname(1:i-1) // '_stag'
 497         call check(nf90_inq_dimid(ncid, stagname, stagid))
 498         call check(nf90_inquire_dimension(ncid, stagid, len=stag(idim)))
 499         sr(idim) = dims(idim)/stag(idim)
 500         if(debug_print)write(*,'(3a,i5,a,i5)')'dimension ',trim(stagname), &
 501            ' length ',stag(idim),' ratio ',sr(idim)
 502     endif
 503     stagnames(idim)=stagname
 504     dims(idim) = dims(idim) - sr(idim)
 505   enddo
 506   if((sr(1).ne.0.and.sr(2).eq.0).or.sr(1).lt.0.or.sr(2).lt.0)then
 507     write(msg,'(a,2i5)')'bad subgrid refinement ratios',sr(1),sr(2)
 508     call crash(msg)
 509   endif
 510 endif
 511
 512 call check(nf90_close(ncid))
 513
 514 ! store the rest in info
 515 info%nfirex=dims(1)
 516 info%nfirey=dims(2)
 517 info%sr_x=sr(1)
 518 info%sr_y=sr(2)
 519 info%nstagx=stag(1)
 520 info%nstagy=stag(2)
 521 info%dim_atm_x_s=stagnames(1)
 522 info%dim_atm_y_s=stagnames(2)
 523 if(sr(1).ne.0)then
 524     info%fdx=info%fdx/sr(1)
 525     info%fdy=info%fdy/sr(2)
 526 endif
 527
 528 if(debug_print)then
 529   write(*,'(4(a,1x))')'dimension names:',trim(info%dim_fire_x),trim(info%dim_fire_y), &
 530      trim(info%dim_time)
 531   write(*,'(a,2i6)')'fire grid dimensions:',info%nfirex,info%nfirey
 532   write(*,'(a,i6)')'number of time frames',info%ntimes
 533   write(*,'(3(a,f8.4,1x))')'stepsizes fdx=',info%fdx,'fdy=',info%fdy,'dt=',info%dt
 534 endif
 535
 536 end subroutine read_info
 537
 538 subroutine dim_read(ncid,dim_name,dim_len)
 539 character(len=*),intent(in)::dim_name
 540 integer, intent(in)::ncid
 541 integer,intent(out):: dim_len
 542 integer:: dim_id
 543 call check(nf90_inq_dimid(ncid,dim_name,dim_id))
 544 call check(nf90_inquire_dimension(ncid,dim_id,len=dim_len))
 545 if(debug_print)write(*,'(a,1x,a,i6)')'dimension',trim(dim_name),dim_len
 546 end subroutine dim_read
 547
 548 subroutine att_read(ncid,att_name,att_val)
 549 integer, intent(in)::ncid
 550 character(len=*),intent(in)::att_name
 551 real, intent(out)::att_val
 552 call check(nf90_get_att(ncid,nf90_global,att_name,att_val))
 553 if(debug_print)write(*,'(a,1x,a,g20.5)')'attribute',trim(att_name),att_val
 554 end subroutine att_read
 555
 556 !
 557 !***
 558 !
 559
 560 subroutine print_var_info(filename,varname)
 561
 562 !*** arguments
 563 character(len=*), intent(in)::filename,varname
 564
 565 !*** local
 566 integer::ncid,ndims,dimlengths(mdims),dimids(mdims),i,type
 567 character(len=NF90_MAX_NAME)::dimnames(mdims)
 568
 569 !*** executable
 570 if(debug_print)write(*,'(4a)')'reading file ',filename,' dimensions of variable ',trim(varname)
 571 call read_var_info(filename,varname,ndims,dimlengths,dimnames)
 572 if(debug_print)write(*,'(3a,4(2a,i5,1x))')'variable ',trim(varname),' dimensions ', &
 573   (trim(dimnames(i)),'=',dimlengths(i),i=1,ndims)
 574
 575 end subroutine print_var_info
 576
 577 !
 578 !***
 579 !
 580
 581 subroutine read_var_info(filename,varname,ndims,dimlengths,dimnames,type)
 582
 583 ! get variable dimensions from a file
 584 implicit none
 585
 586 ! arguments
 587 character(len=*), intent(in):: filename ! variable name
 588 character(len=*), intent(in):: varname ! variable name
 589 integer, intent(out)::ndims            ! number of dimensions of this variable
 590 integer, intent(out)::dimlengths(mdims)      ! the dimensions
 591 character(len=NF90_MAX_NAME),intent(out)::dimnames(mdims) ! dimension names
 592 integer, intent(out), optional :: type
 593
 594 ! local
 595 integer :: ncid             ! open netcdf file
 596 integer::varid,dimid,idimids(mdims),idim,i,dimlen,xtype
 597 character(len=NF90_MAX_NAME)::dimname
 598
 599 ! executable
 600 if(debug_print)write(*,'(4a)')'reading file ',trim(filename),' variable ',trim(varname)
 601 call ncopen(filename,nf90_nowrite,ncid)
 602 call check(nf90_inq_varid(ncid, varname, varid))
 603 call check(nf90_inquire_variable(ncid,varid,ndims=ndims,xtype=xtype))
 604 if(ndims.gt.mdims)then
 605     write(*,1)'variable ',trim(varname),' has ',ndims,' dimensions >',mdims
 606     call crash('variable has too many dimensions')
 607 1 format(3a,i5,a,(4i6))
 608 endif
 609 call check(nf90_inquire_variable(ncid, varid, dimids=idimids))
 610 do idim=1,ndims
 611     if(debug_print)write(*,'(a,i3,a,i6)')'inquiring dimension ',idim,' id',idimids(idim)
 612     call check(nf90_inquire_dimension(ncid, idimids(idim), dimname, dimlen))
 613     if(debug_print)write(*,'(3a,i5)')'got dimension name ',trim(dimname),' length',dimlen
 614     dimnames(idim)=dimname
 615     dimlengths(idim) = dimlen
 616 enddo
 617 call check(nf90_close(ncid))
 618 if(present(type)) type=xtype
 619 2 format(3a,i4,a,(4i6))
 620 if(debug_print)write(*,2)'variable ',trim(varname), &
 621    ' type',xtype,' dimensions ',(dimlengths(idim),idim=1,ndims)
 622 end subroutine read_var_info
 623
 624 !
 625 !***
 626 !
 627
 628 subroutine write_fire_var(ncid,info,iframe,varname,v)
 629 implicit none
 630 !*** arguments
 631 integer, intent(in)::ncid             ! id of netcdf file open in data mode
 632 type(grid_info),intent(in)::info      ! dimensions
 633 integer, intent(in):: iframe          ! number of frame in the file
 634 character(len=*),intent(in)::varname  ! the variable name
 635 real, pointer, intent(in):: v(:,:)            ! values
 636 !*** local
 637 integer::varid,nx,ny,i,j
 638 real,pointer::v2(:,:)
 639 real::vmin,vmax,err
 640 !*** executable
 641 nx=info%nfirex
 642 ny=info%nfirey
 643 allocate(v2(nx,ny))
 644
 645 vmin=huge(vmin)
 646 vmax=-huge(vmax)
 647 do j=1,ny
 648   do i=1,nx
 649     vmin=min(vmin,v(i,j))
 650     vmax=max(vmax,v(i,j))
 651   enddo
 652 enddo
 653
 654 if(debug_print)write(*,'(3a,2i5,2(a,g19.6))')'writing variable ',trim(varname), &
 655     ' size ',nx,ny,' min',vmin,' max',vmax
 656 call check(nf90_inq_varid(ncid,varname,varid),'cannot find '//trim(varname))
 657 call check(nf90_put_var(ncid,varid,v(1:nx,1:ny),start=(/1,1,iframe/),count=(/nx,ny,1/)), &
 658      'error writing '//trim(varname))
 659
 660 if(read_check)then
 661   call read_fire_var(ncid,info,iframe,varname,v2) ! read back to check
 662   err=0
 663   do j=1,ny
 664     do i=1,nx
 665       err=max(err,v(i,j)-v2(i,j))
 666     enddo
 667   enddo
 668   write(*,'(a,g19.6)')'max write-read error',err
 669 endif
 670
 671 end subroutine write_fire_var
 672
 673 !
 674 !***
 675 !
 676
 677 subroutine write_integer(ncid,iframe,varname,iv)
 678 implicit none
 679 !*** arguments
 680 integer, intent(in)::ncid             ! id of netcdf file open in data mode
 681 integer, intent(in):: iframe          ! number of frame in the file
 682 character(len=*),intent(in)::varname  ! the variable name
 683 integer, intent(in):: iv                  ! values
 684 !*** local
 685 integer::iv2,ierr
 686 integer::varid
 687 !*** executable
 688
 689 if(debug_print)write(*,'(3a,i5,a,i10)')'writing int ',trim(varname),'(',iframe,')=',iv
 690 call check(nf90_inq_varid(ncid,varname,varid),'cannot find '//trim(varname))
 691 call check(nf90_put_var(ncid,varid,iv,start=(/iframe/)), &
 692      'error writing '//trim(varname))
 693 if(read_check)then
 694   call read_integer(ncid,iframe,varname,iv2) ! read back to check
 695   ierr=iv2-iv
 696   write(*,'(a,i6)')'write-read error',ierr
 697 endif
 698
 699 end subroutine write_integer
 700 !
 701 !***
 702 !
 703
 704 subroutine write_real(ncid,iframe,varname,v)
 705 implicit none
 706 !*** arguments
 707 integer, intent(in)::ncid             ! id of netcdf file open in data mode
 708 integer, intent(in):: iframe          ! number of frame in the file
 709 character(len=*),intent(in)::varname  ! the variable name
 710 real, intent(in):: v                  ! values
 711 !*** local
 712 real::v2,val(1),err
 713 integer::varid
 714 !*** executable
 715
 716 if(debug_print)write(*,'(3a,i5,a,g19.6)')'writing real ',trim(varname),'(',iframe,')=',v
 717 call check(nf90_inq_varid(ncid,varname,varid),'cannot find '//trim(varname))
 718 val(1)=v
 719 call check(nf90_put_var(ncid,varid,val,start=(/iframe/),count=(/1/)), &
 720      'error writing '//trim(varname))
 721 if(read_check)then
 722   call read_real(ncid,iframe,varname,v2) ! read back to check
 723   err=v2-v
 724   write(*,'(a,g19.6)')'write-read error',err
 725 endif
 726
 727 end subroutine write_real
 728
 729 !
 730 !***
 731 !
 732
 733 subroutine read_fire_var(ncid,info,iframe,varname,v)
 734 implicit none
 735 !*** arguments
 736 integer, intent(in)::ncid             ! id of netcdf file open in data mode
 737 type(grid_info),intent(in)::info      ! dimensions
 738 integer, intent(in):: iframe          ! number of frame in the file
 739 character(len=*),intent(in)::varname  ! the variable name
 740 real, pointer :: v(:,:)            ! values
 741 !*** local
 742 integer::varid,nx,ny,start(3),count(3)
 743 !*** executable
 744 nx=info%nfirex
 745 ny=info%nfirey
 746
 747 if(debug_print)write(*,'(2a)')'reading variable ',trim(varname)
 748 if(debug_print)write(*,'(a,4i10)')'lower bounds',lbound(v)
 749 if(debug_print)write(*,'(a,4i10)')'upper bounds',ubound(v)
 750 call check(nf90_inq_varid(ncid,varname,varid),'cannot find '//trim(varname))
 751 call check(nf90_get_var(ncid,varid,v(1:nx,1:ny),start=(/1,1,iframe/),count=(/nx,ny,1/)), &
 752      'error reading '//trim(varname))
 753 if(debug_print)write(*,'(a,2i5,a,1x,e15.5,3(1x,a,e15.5))')'dimensions',nx,ny, &
 754      'min',minval(v(1:nx,1:ny)),'max',maxval(v(1:nx,1:ny)),'(1,1)=',v(1,1),'end=',v(nx,ny)
 755
 756 end subroutine read_fire_var
 757
 758 !
 759 !***
 760 !
 761
 762 subroutine read_integer(ncid,iframe,varname,iv)
 763 implicit none
 764 !*** arguments
 765 integer, intent(in)::ncid             ! id of netcdf file open in data mode
 766 integer, intent(in):: iframe          ! number of frame in the file
 767 character(len=*),intent(in)::varname  ! the variable name
 768 integer :: iv                ! value
 769 !*** local
 770 integer::varid
 771
 772 !*** executable
 773
 774 if(debug_print)write(*,'(3a,i5)')'reading integer',trim(varname),' timestep ',iframe
 775 call check(nf90_inq_varid(ncid,varname,varid),'cannot find '//trim(varname))
 776 call check(nf90_get_var(ncid,varid,iv,start=(/iframe/)), &
 777     'error reading '//trim(varname))
 778 if(debug_print)write(*,'(2a,i5,a,i8)')trim(varname),'(',iframe,')=',iv
 779
 780 end subroutine read_integer
 781
 782 !
 783 !***
 784 !
 785
 786 subroutine read_real(ncid,iframe,varname,v)
 787 implicit none
 788 !*** arguments
 789 integer, intent(in)::ncid             ! id of netcdf file open in data mode
 790 integer, intent(in):: iframe          ! number of frame in the file
 791 character(len=*),intent(in)::varname  ! the variable name
 792 real :: v                ! value
 793 !*** local
 794 integer::varid
 795 real:: val(1)
 796
 797 !*** executable
 798
 799 if(debug_print)write(*,'(3a,i5)')'reading real ',trim(varname),' timestep ',iframe
 800 call check(nf90_inq_varid(ncid,varname,varid),'cannot find '//trim(varname))
 801 call check(nf90_get_var(ncid,varid,val,start=(/iframe/),count=(/1/)), &
 802     'error reading '//trim(varname))
 803 v=val(1)
 804 if(debug_print)write(*,'(2a,i5,a,g18.8)')trim(varname),'(',iframe,')=',v
 805
 806 end subroutine read_real
 807
 808 !
 809 !***
 810 !
 811
 812 subroutine read_vars(filename,info,iframe,grid)
 813 ! read all variables from input file
 814 implicit none
 815
 816 !*** arguments
 817 character(len=*),intent(in)::filename ! the input file
 818 type(grid_info),intent(inout)::info   ! dimensions
 819 integer, intent(in):: iframe          ! number of frame in the file
 820 type(domain),intent(inout)::grid      ! the mother of all arrays
 821
 822 !*** local
 823 integer::ncid,varid,ierr
 824 integer,dimension(4)::s,c
 825
 826 !*** executable
 827 if(debug_print_f)write(*,'(3a,i4)')'read_vars: reading file ',trim(filename),' frame ',iframe
 828 call ncopen(filename,nf90_nowrite,ncid)
 829
 830 call check(nf90_inq_varid(ncid,var_times,varid),'cannot find '//trim(var_times))
 831 call check(nf90_get_var(ncid,varid,info%times,start=(/1,iframe/),count=(/info%len_time_string,1/)), &
 832      'error reading '//trim(var_times))
 833 if(debug_print_f)write(*,'(2a)')'Time ',info%times
 834
 835 call read_real(ncid,iframe,var_unit_fxlong,grid%unit_fxlong)
 836 call read_real(ncid,iframe,var_unit_fxlat,grid%unit_fxlat)
 837 call read_fire_var(ncid,info,iframe,var_nfuel_cat,grid%nfuel_cat)
 838 call read_fire_var(ncid,info,iframe,var_dzdxf,grid%dzdxf)
 839 call read_fire_var(ncid,info,iframe,var_dzdyf,grid%dzdyf)
 840 call read_fire_var(ncid,info,iframe,var_zsf,grid%zsf)
 841 call read_fire_var(ncid,info,iframe,var_fxlong,grid%fxlong)
 842 call read_fire_var(ncid,info,iframe,var_fxlat,grid%fxlat)
 843 call read_fire_var(ncid,info,iframe,var_fmc_g,grid%fmc_g)
 844 !call read_fire_var(ncid,info,iframe,var_unit_fxlong,grid%unit_fxlong)
 845 !call read_fire_var(ncid,info,iframe,var_unit_fxlat,grid%unit_fxlat)
 846 call read_fire_var(ncid,info,iframe,var_uf,grid%uf)
 847 call read_fire_var(ncid,info,iframe,var_vf,grid%vf)
 848
 849 call check(nf90_close(ncid))
 850 end subroutine read_vars
 851
 852 !
 853 !***
 854 !
 855
 856 subroutine check(ncerr,msg,cont)
 857 implicit none
 858 integer,intent(in)::ncerr
 859 character(len=*), optional, intent(in)::msg
 860 logical, intent(in), optional::cont
 861 character(len=128)::message
 862 if(ncerr.ne.nf90_noerr)then
 863   write(6,'(2a)')"NetCDF error: ",trim(nf90_strerror(ncerr))
 864   if(present(msg))then
 865     message=msg
 866   else
 867     message="NETCDF ERROR"
 868   endif
 869   if(present(cont))then
 870     if(cont)return
 871   endif
 872   call crash(message)
 873 endif
 874 end subroutine check
 875
 876 !
 877 !***
 878 !
 879
 880 subroutine ncopen(filename,mode,ncid)
 881 !*** purpose: open netcdf file with an informative error message
 882 implicit none
 883 !*** arguments
 884 character(len=*), intent(in):: filename
 885 integer, intent(in)::mode
 886 integer, intent(out):: ncid
 887 !*** executable
 888 call check(nf90_open(filename,mode,ncid),"Cannot open file "//trim(filename))
 889 end subroutine ncopen
 890
 891 end module wrf_netcdf