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