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