standalone/fire_ros_main.F

   1 program fire_ros_main
   2
   3 use module_fr_sfire_phys
   4 use module_fr_sfire_util
   5
   6 !*** variables
   7
   8 implicit none
   9 type(fire_params)::fp
  10
  11 real,pointer,dimension(:,:):: propx,propy          ! direction of propagation
  12 real,pointer,dimension(:,:):: vx,vy                ! wind velocity (m/s)
  13 real,pointer,dimension(:,:):: dzdxf,dzdyf          ! terrain grad (1)
  14 real,pointer,dimension(:,:):: fmc_g                ! fuel moisture contents, ground (1)
  15 real,pointer,dimension(:,:):: nfuel_cat            ! fuel category (integer values)
  16 real,pointer,dimension(:,:):: tempf                ! temperature at 2m (K) (Balbi model only)
  17 real,pointer,dimension(:,:):: rhof                 ! surface air density (kg/m^3) (Balbi model only)
  18 real,pointer,dimension(:,:):: ffwidth              ! fire front width (m) (Balbi model only)
  19 real,pointer,dimension(:,:):: fmc_gc01             ! fuel moisture contents, ground by class (1)
  20 real,pointer,dimension(:,:):: fmc_gc02             ! fuel moisture contents, ground by class (1)
  21 real,pointer,dimension(:,:):: fmc_gc03             ! fuel moisture contents, ground by class (1)
  22 real,pointer,dimension(:,:):: fmc_gc04             ! fuel moisture contents, ground by class (1)
  23 real,pointer,dimension(:,:):: fmc_gc05             ! fuel moisture contents, ground by class (1)
  24 real,pointer,dimension(:,:):: fmc_gc06             ! fuel moisture contents, ground by class (1)
  25 real,pointer,dimension(:,:,:):: fmc_gc_f           ! fuel moisture contents, ground by class (1)
  26 real,pointer,dimension(:,:):: ros                  ! fire rate of spread (m/s)
  27
  28 integer:: n=10, iounit=9, ierr, i, j, nfmc
  29 logical:: have_data=.true.
  30 character(len=50)::file_in="namelist_standalone.input",file_out="namelist_standalone.output"
  31 character(len=128)::msg
  32 character(len=9), dimension(4)::model=(/'Rothermel','Balbi    ','WIRC     ','Behave   '/)
  33
  34 ! namelist_standalone.input options
  35 namelist /control/n,fire_print_msg,balbi_msglevel,behave_msglevel,call_write_fuels_m,compare_rothermel,nfmc
  36 namelist /data/propx,propy,vx,vy,dzdxf,dzdyf,fmc_g,nfuel_cat,tempf,rhof,ffwidth,ros, &
  37       fmc_gc01,fmc_gc02,fmc_gc03,fmc_gc04,fmc_gc05,fmc_gc06
  38
  39
  40 !*** executable
  41
  42 ! defaults, can set in &control
  43 fire_print_msg = -1  ! suppress messages and warnings from WRF-SFIRE
  44 balbi_msglevel = 1           ! prints in fire_ros_balbi
  45 behave_msglevel = 1          ! prints in fire_ros_balbi
  46 call_write_fuels_m = .false. ! create fuels.m for graphics
  47 fire_fmc_read = 0            ! prevent overwing of fmc_f in init_fuels_cat
  48
  49 ! read namelist.fire into fuels
  50 ! also create file fuels.m read and visualize the results as described in
  51 ! https://wiki.openwfm.org/wiki/How_to_diagnose_fuel_properties_in_WRF-SFIRE
  52
  53 print *,'Reading file '//trim(file_in)
  54 OPEN(iounit, FILE=trim(file_in),FORM='FORMATTED',STATUS='OLD',ACTION='READ',IOSTAT=ierr)
  55 if(ierr.ne.0)then
  56      print *,'Cannot open file '//trim(file_in)//' for reading,using defaults'
  57      n=1
  58      have_data=.false.
  59      goto 100
  60 endif
  61 read(iounit,control,iostat=ierr)
  62 if(ierr.ne.0)then
  63      n=1
  64      print *,'Cannot read namelist &control in file '//trim(file_in)//', using defaults'
  65      have_data=.false.
  66      goto 100
  67 endif
  68
  69 100 continue
  70 print *,'fire_ros using control parameters:'
  71 print *,'number of cases in namelist &data                n=',n
  72 print *,'WRF-SFIRE print level               fire_print_msg=',fire_print_msg
  73 print *,'print level in fire_ros_balbi       balbi_msglevel=',balbi_msglevel
  74 print *,'write file fuels.m for graphics call_write_fuels_m=',call_write_fuels_m
  75 print *,'compare codes (ibeh=1 only)      compare_rothermel=',compare_rothermel
  76 print *,'number of fuel moisture classes               nfmc=',nfmc
  77 write(*,control)
  78
  79 print *,'Initializing fuel categories from file namelist.fire'
  80 if(call_write_fuels_m)then
  81      print *,'and writing file fuels.m. For a guide how to use fuels.m, see'
  82      print *,'https://wiki.openwfm.org/wiki/How_to_diagnose_fuel_properties_in_WRF-SFIRE'
  83 endif
  84 call init_fuel_cats(init_fuel_moisture=.true.)
  85 print *,'Fire ROS model from file namelist.fire is ibeh=',ibeh,' ',model(ibeh)
  86
  87 ! allocate our arrays used in namelist
  88 allocate(propx(1,n),propy(1,n),vx(1,n),vy(1,n),dzdxf(1,n),dzdyf(1,n),fmc_g(1,n),nfuel_cat(1,n),tempf(1,n),rhof(1,n),ffwidth(1,n),ros(1,n))
  89 allocate(fmc_gc01(1,n),fmc_gc02(1,n),fmc_gc03(1,n),fmc_gc04(1,n),fmc_gc05(1,n),fmc_gc06(1,n))
  90 allocate(fmc_gc_f(1,nfmc,n))
  91
  92 ! allocate the rest of the arrays in fp
  93 allocate(fp%fgip(1,n),fp%ischap(1,n),fp%phisc(1,n),fp%bbb(1,n),fp%fuel_time(1,n),fp%phiwc(1,n),fp%r_0(1,n))
  94
  95 ! initialize our arrays to reasonable values that won't crash the code
  96 propx = 0.
  97 propy = 0.
  98 vx = 0.
  99 vy = 0.
 100 dzdxf = 0.
 101 dzdyf = 0.
 102 fmc_g = 0.
 103 fmc_gc01 = 0.
 104 fmc_gc02 = 0.
 105 fmc_gc03 = 0.
 106 fmc_gc04 = 0.
 107 fmc_gc05 = 0.
 108 fmc_gc06 = 0.
 109 fmc_gc_f = 0.
 110 nfuel_cat=1   ! some fuel
 111 tempf = 273.    ! temp K
 112 rhof = 1.2    ! air density (kg/m^3)
 113 ffwidth = 10. ! fire front width m
 114 ros = 0.
 115
 116 if(have_data)then
 117      read(iounit,data,iostat=ierr)
 118      if(ierr.ne.0)then
 119           print *,'cannot read namelist &data in file '//trim(file_in)
 120           have_data=.false.
 121      endif
 122 endif
 123
 124 close(iounit,iostat=ierr)
 125
 126 do j=1,n
 127     fmc_gc_f(1,1,j)=fmc_gc01(1,j)
 128     fmc_gc_f(1,2,j)=fmc_gc02(1,j)
 129     fmc_gc_f(1,3,j)=fmc_gc03(1,j)
 130     fmc_gc_f(1,4,j)=fmc_gc04(1,j)
 131     fmc_gc_f(1,5,j)=fmc_gc05(1,j)
 132     fmc_gc_f(1,6,j)=fmc_gc06(1,j)
 133 enddo
 134
 135 print *,'propx=',propx
 136 print *,'propy=',propy
 137 print *,'vx=',vx
 138 print *,'vy=',vy
 139 print *,'dzdxf=',dzdxf
 140 print *,'dzdyf=',dzdyf
 141 print *,'fmc_g=',fmc_g
 142 print *,'nfuel_cat=',nfuel_cat
 143 print *,'tempf=',tempf
 144 print *,'rhof=',rhof
 145 print *,'ffwidth=',ffwidth
 146 print *,'fmc_gc_f=',fmc_gc_f
 147 fp%vx => vx
 148 fp%vy => vy
 149 fp%dzdxf => dzdxf
 150 fp%dzdyf => dzdyf
 151 fp%fmc_g => fmc_g
 152 fp%tempf => tempf
 153 fp%rhof => rhof
 154 fp%ffwidth => ffwidth
 155 fp%fmc_gc_f => fmc_gc_f
 156 fp%nfuel_cat => nfuel_cat
 157
 158 ! set up fuel arrays in fp
 159 !subroutine set_fire_params( &
 160 !                       ifds,ifde,jfds,jfde, &
 161 !                       ifms,ifme,jfms,jfme, &
 162 !                       ifts,ifte,jfts,jfte, &
 163 !                       fdx,fdy,nfuel_cat0,  &
 164 !                       nfuel_cat,fuel_time, &
 165 !                       fp )
 166
 167 call set_fire_params( &
 168                            1,1,1,n, &
 169                            1,1,1,n, &
 170                            1,1,1,n, &
 171                            0.,0.,0,  &
 172                            nfuel_cat,fp%fuel_time, &
 173                            fp )
 174
 175
 176 i=1
 177 do j=1,n
 178          call fire_ros(ros(i,j), &
 179                  propx(i,j),propy(i,j),i,j,fp,ierr,msg)
 180          if(ierr.ne.0)call crash(msg)
 181 enddo
 182
 183 print *,'computed ros=',ros
 184
 185 print *,'writing file '//trim(file_out)
 186 OPEN(iounit, FILE=trim(file_out),FORM='FORMATTED',STATUS='UNKNOWN',ACTION='WRITE',IOSTAT=ierr)
 187 if(ierr.ne.0)call crash('cannot open file '//trim(file_out)//' for writing')
 188 write(iounit,control,iostat=ierr)
 189 if(have_data)then
 190      write(*,*)       'ros computed from inputs in file '//trim(file_in)
 191      write(iounit,*)'! ros computed from inputs in file '//trim(file_in)
 192 else
 193      write(*,*)       'ros computed from defaults, use as a template ONLY:'
 194      write(iounit,*)'! ros computed from defaults, use as a template ONLY:'
 195      write(*,*)       'cp '//trim(file_out)//' '//trim(file_in)//' and edit'
 196      write(iounit,*)'! cp '//trim(file_out)//' '//trim(file_in)//' and edit'
 197 endif
 198 write(iounit,data,iostat=ierr)
 199 close(iounit,iostat=ierr)
 200
 201 end program fire_ros_main