wrfv2_fire/chem/convert_bioemiss.F

   1 ! This is a program that converts biobenic emissions data
   2 !    into WRF input data.
   3 !
   4
   5 PROGRAM convert_bioemiss
   6 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   7
   8    USE module_machine
   9    USE module_domain
  10    USE module_initialize
  11    USE module_integrate
  12    USE module_driver_constants
  13    USE module_configure
  14    USE module_io_wrf
  15    USE module_io_domain
  16    USE module_timing
  17    USE module_utility
  18    USE module_wrf_error
  19    USE module_input_chem_bioemiss
  20 #ifdef DM_PARALLEL
  21    USE module_dm
  22 #endif
  23
  24 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  25    IMPLICIT NONE
  26
  27    INTERFACE
  28      SUBROUTINE Setup_Timekeeping( grid )
  29       USE module_domain
  30       TYPE(domain), POINTER :: grid
  31      END SUBROUTINE Setup_Timekeeping
  32    END INTERFACE
  33
  34    REAL    :: time
  35
  36    INTEGER :: loop , levels_to_process
  37    INTEGER :: rc
  38
  39    TYPE(domain) , POINTER      :: keep_grid, grid_ptr, null_domain, grid, ingrid
  40    TYPE (grid_config_rec_type) :: config_flags, config_flags_in
  41    INTEGER                     :: number_at_same_level
  42
  43    INTEGER :: max_dom, domain_id
  44    INTEGER :: id1 , id , fid, ierr
  45    INTEGER :: idum1, idum2 , ihour
  46 #ifdef DM_PARALLEL
  47    INTEGER                 :: nbytes
  48    INTEGER, PARAMETER      :: configbuflen = 4* CONFIG_BUF_LEN
  49    INTEGER                 :: configbuf( configbuflen )
  50    LOGICAL , EXTERNAL      :: wrf_dm_on_monitor
  51 #endif
  52
  53    REAL    :: dt_from_file, tstart_from_file, tend_from_file
  54    INTEGER :: ids , ide , jds , jde , kds , kde
  55    INTEGER :: ims , ime , jms , jme , kms , kme
  56    INTEGER :: i , j , k , idts, ntsd, emi_frame, nemi_frames
  57    INTEGER :: debug_level = 0
  58
  59    CHARACTER (LEN=80)     :: message
  60
  61    CHARACTER(LEN=24) :: previous_date , this_date , next_date
  62    CHARACTER(LEN=19) :: start_date_char , end_date_char , current_date_char , next_date_char
  63    CHARACTER(LEN= 4) :: loop_char
  64
  65    INTEGER :: start_year , start_month , start_day , start_hour , start_minute , start_second
  66    INTEGER ::   end_year ,   end_month ,   end_day ,   end_hour ,   end_minute ,   end_second
  67    INTEGER :: interval_seconds , real_data_init_type
  68    INTEGER :: time_loop_max , time_loop
  69
  70    REAL :: cen_lat, cen_lon, moad_cen_lat, truelat1, truelat2, gmt, stand_lon, dum1
  71    INTEGER :: map_proj, julyr, julday, iswater, isice, isurban, isoilwater
  72    CHARACTER(LEN= 8) :: chlanduse
  73
  74
  75    CHARACTER (LEN=80) :: inpname , eminame, dum_str, wrfinname
  76
  77 ! these are needed on some compilers, eg compaq/alpha, to
  78 ! permit pass by reference through the registry generated
  79 ! interface to med_read_emissions, below
  80 #ifdef DEREF_KLUDGE
  81    INTEGER     :: sm31 , em31 , sm32 , em32 , sm33 , em33
  82 #endif
  83
  84    !  Get the NAMELIST data for input.
  85
  86    !  Define the name of this program (program_name defined in module_domain)
  87
  88    program_name = "WRF V2.1.2 BIOGENIC EMISSIONS PREPROCESSOR"
  89
  90 #ifdef DM_PARALLEL
  91    CALL disable_quilting
  92 #endif
  93
  94 !  CALL init_modules
  95    CALL       wrf_debug ( 100 , 'convert_emiss: calling init_modules ' )
  96    CALL init_modules(1)   ! Phase 1 returns after MPI_INIT() (if it is called)
  97    CALL WRFU_Initialize( defaultCalendar=WRFU_CAL_GREGORIAN, rc=rc )
  98    CALL init_modules(2)   ! Phase 2 resumes after MPI_INIT() (if it is called)
  99
 100
 101 #ifdef DM_PARALLEL
 102    IF ( wrf_dm_on_monitor() ) THEN
 103      CALL initial_config
 104      CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
 105      CALL wrf_dm_bcast_bytes( configbuf, nbytes )
 106      CALL set_config_as_buffer( configbuf, configbuflen )
 107    ENDIF
 108    CALL wrf_dm_initialize
 109 #else
 110    CALL initial_config
 111 #endif
 112
 113    CALL  wrf_message ( program_name )
 114
 115    CALL init_wrfio
 116
 117 !     !  Get the grid info from the wrfinput file
 118
 119    write(message,FMT='(A)') ' allocate for wrfinput_d01 '
 120    CALL  wrf_message ( program_name )
 121    NULLIFY( null_domain )
 122    CALL alloc_and_configure_domain ( domain_id  = 1           , &
 123                                      grid       = head_grid   , &
 124                                      parent     = null_domain , &
 125                                      kid        = -1            )
 126    write(message,FMT='(A)') ' pointer for wrfinput_d01 '
 127    CALL  wrf_debug ( 100, message )
 128    grid => head_grid
 129    write(message,FMT='(A)') ' set scalars for wrfinput_d01 '
 130    CALL  wrf_debug ( 100, message )
 131    CALL set_scalar_indices_from_config ( grid%id , idum1, idum2 )
 132
 133    write(message,FMT='(A)') ' construct filename for wrfinput_d01 '
 134    CALL  wrf_debug ( 100, message )
 135    CALL construct_filename1( wrfinname , 'wrfinput' , grid%id , 2 )
 136
 137    write(message,FMT='(A,A)') ' open file ',TRIM(wrfinname)
 138    CALL  wrf_message ( message )
 139    CALL open_r_dataset ( fid, TRIM(wrfinname) , grid , config_flags , "DATASET=INPUT", ierr )
 140
 141
 142    write(message,FMT='(A)') ' wrfinput open error check '
 143    CALL  wrf_debug ( 100, message )
 144    IF ( ierr .NE. 0 ) THEN
 145       WRITE( wrf_err_message , FMT='(A,A,A,I8)' )  &
 146           'program convert_emiss: error opening ',TRIM(wrfinname),' for reading ierr=',ierr
 147       CALL WRF_ERROR_FATAL ( wrf_err_message )
 148    ENDIF
 149    write(message,FMT='(A)') ' past opening wrfinput_d01 '
 150    CALL  wrf_debug ( 100, message )
 151
 152       CALL wrf_get_dom_ti_integer ( fid , 'MAP_PROJ' ,  map_proj , 1 , idum1 , ierr )
 153       CALL wrf_get_dom_ti_real    ( fid , 'CEN_LAT' , cen_lat , 1 , idum1 , ierr )
 154       CALL wrf_get_dom_ti_real    ( fid , 'CEN_LON' , cen_lon , 1 , idum1 , ierr )
 155       CALL wrf_get_dom_ti_real    ( fid , 'MOAD_CEN_LAT' , moad_cen_lat , 1 , idum1 , ierr )
 156       CALL wrf_get_dom_ti_real    ( fid , 'STAND_LON' , stand_lon , 1 , idum1 , ierr )
 157       CALL wrf_get_dom_ti_real    ( fid , 'TRUELAT1' , truelat1 , 1 , idum1 , ierr )
 158       CALL wrf_get_dom_ti_real    ( fid , 'TRUELAT2' , truelat2 , 1 , idum1 , ierr )
 159       CALL wrf_get_dom_ti_real    ( fid , 'GMT' , gmt , 1 , idum1 , ierr )
 160       CALL wrf_get_dom_ti_integer ( fid , 'JULYR' , julyr , 1 , idum1 , ierr )
 161       CALL wrf_get_dom_ti_integer ( fid , 'JULDAY' , julday , 1 , idum1 , ierr )
 162       CALL wrf_get_dom_ti_integer ( fid , 'ISWATER' , iswater , 1 , idum1 , ierr )
 163       CALL wrf_get_dom_ti_integer ( fid , 'ISICE  ' , isice   , 1 , idum1 , ierr )
 164       CALL wrf_get_dom_ti_integer ( fid , 'ISURBAN' , isurban , 1 , idum1 , ierr )
 165       CALL wrf_get_dom_ti_integer ( fid , 'ISOILWATER' , isoilwater , 1 , idum1 , ierr )
 166       CALL wrf_get_dom_ti_char    ( fid , 'MMINLU'  , chlanduse , ierr )
 167
 168       CALL close_dataset      ( fid , config_flags , "DATASET=INPUT" )
 169
 170
 171    !  An available simple timer from the timing module.
 172
 173    CALL set_scalar_indices_from_config ( grid%id , idum1, idum2 )
 174
 175    CALL Setup_Timekeeping ( grid )
 176    CALL domain_clock_set( grid, &
 177                           time_step_seconds=model_config_rec%interval_seconds )
 178    CALL domain_clock_get ( grid, current_timestr=message )
 179    write(message,FMT='(A,A)') ' current_time ',Trim(message)
 180    CALL  wrf_debug ( 100, message )
 181
 182    CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
 183
 184 !  print *,'start date=',model_config_rec%start_year(grid%id),model_config_rec%start_month(grid%id),&
 185 !  model_config_rec%start_day(grid%id),model_config_rec%start_hour(grid%id)
 186 !  print *,'end   date=',model_config_rec%end_year(grid%id),model_config_rec%end_month(grid%id),&
 187 !  model_config_rec%end_day(grid%id),model_config_rec%end_hour(grid%id)
 188 !  print *,'interval  =',model_config_rec%interval_seconds
 189 !  print *,'init_typ  =',model_config_rec%real_data_init_type
 190
 191    !  Figure out the starting and ending dates in a character format.
 192
 193    start_year   = model_config_rec%start_year  (grid%id)
 194    start_month  = model_config_rec%start_month (grid%id)
 195    start_day    = model_config_rec%start_day   (grid%id)
 196    start_hour   = model_config_rec%start_hour  (grid%id)
 197    start_minute = model_config_rec%start_minute(grid%id)
 198    start_second = model_config_rec%start_second(grid%id)
 199
 200    end_year   = model_config_rec%  end_year  (grid%id)
 201    end_month  = model_config_rec%  end_month (grid%id)
 202    end_day    = model_config_rec%  end_day   (grid%id)
 203    end_hour   = model_config_rec%  end_hour  (grid%id)
 204    end_minute = model_config_rec%  end_minute(grid%id)
 205    end_second = model_config_rec%  end_second(grid%id)
 206
 207    interval_seconds    = 3600
 208    real_data_init_type = model_config_rec%real_data_init_type
 209
 210    WRITE ( start_date_char , FMT = '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
 211            start_year,start_month,start_day,start_hour,start_minute,start_second
 212    WRITE (   end_date_char , FMT = '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
 213              end_year,  end_month,  end_day,  end_hour,  end_minute,  end_second
 214
 215 ! these are needed on some compilers, eg compaq/alpha, to
 216 ! permit pass by reference through the registry generated
 217 ! interface to med_read_emissions, below
 218 #ifdef DEREF_KLUDGE
 219    sm31             = grid%sm31
 220    em31             = grid%em31
 221    sm32             = grid%sm32
 222    em32             = grid%em32
 223    sm33             = grid%sm33
 224    em33             = grid%em33
 225 #endif
 226
 227    ihour = start_hour
 228    write(message,FMT='(A)') ' READ BIOGENIC EMISSIONS '
 229    CALL  wrf_debug ( 100, message )
 230    CALL input_ext_chem_beis3_file ( grid )
 231    write(message,FMT='(A)') ' PAST READ BIOGENIC EMISSIONS '
 232    CALL  wrf_debug ( 100, message )
 233
 234    grid%input_from_file = .false.
 235
 236    write(message,FMT='(A)') ' OPEN BIOGENIC EMISSIONS WRF file'
 237    CALL  wrf_debug ( 100, message )
 238
 239    CALL construct_filename1( inpname , 'wrfbiochemi' , grid%id , 2 )
 240    CALL open_w_dataset ( id1, TRIM(inpname) , grid , config_flags , output_aux_model_input4 , "DATASET=AUXINPUT4", ierr )
 241    write(message,FMT='(A,A)') ' BIOGENIC EMISSIONS file name: ',TRIM(inpname)
 242    CALL  wrf_message ( message )
 243
 244    IF ( ierr .NE. 0 ) THEN
 245      CALL wrf_error_fatal( 'real: error opening wrfchem emissions file for writing' )
 246    ENDIF
 247
 248    write(message,FMT='(A)') ' PAST OPEN BIOGENIC EMISSIONS WRF file '
 249    CALL  wrf_debug ( 100, message )
 250
 251    CALL calc_current_date ( grid%id , 0. )
 252    CALL geth_newdate ( current_date_char, current_date, 3600 )
 253    current_date = current_date_char // '.0000'
 254
 255       if( stand_lon  == 0. ) then
 256          stand_lon = cen_lon
 257       endif
 258
 259       if( moad_cen_lat  == 0. ) then
 260          moad_cen_lat = cen_lat
 261       endif
 262
 263    CALL output_aux_model_input4 ( id1 , grid , config_flags , ierr )
 264
 265    write(message,FMT='(A)') ' BIOGENIC EMISSIONS: fix global attributes '
 266    CALL  wrf_debug ( 100, message )
 267
 268    ! write global atributes into wrf emissions file
 269
 270     idum1 = 1
 271     call wrf_put_dom_ti_char    ( id1 , 'START_DATE' ,TRIM(start_date_char) , ierr )
 272     CALL wrf_put_dom_ti_integer ( id1 , 'MAP_PROJ'        , map_proj    , 1 , ierr )
 273     CALL wrf_put_dom_ti_real    ( id1 , 'MOAD_CEN_LAT'    , moad_cen_lat, 1 , ierr )
 274     CALL wrf_put_dom_ti_real    ( id1 , 'CEN_LAT'         , cen_lat     , 1 , ierr )
 275     CALL wrf_put_dom_ti_real    ( id1 , 'CEN_LON'         , cen_lon     , 1 , ierr )
 276     CALL wrf_put_dom_ti_real    ( id1 , 'STAND_LON'       , stand_lon   , 1 , ierr )
 277     CALL wrf_put_dom_ti_real    ( id1 , 'TRUELAT1'        , truelat1    , 1 , ierr )
 278     CALL wrf_put_dom_ti_real    ( id1 , 'TRUELAT2'        , truelat2    , 1 , ierr )
 279     CALL wrf_put_dom_ti_real    ( id1 , 'GMT'             , gmt         , 1 , ierr )
 280     CALL wrf_put_dom_ti_integer ( id1 , 'JULYR'           , julyr       , 1 , ierr )
 281     CALL wrf_put_dom_ti_integer ( id1 , 'JULDAY'          , julday      , 1 , ierr )
 282 !   CALL wrf_put_dom_ti_integer ( id1 , 'CHEM_OPT'        , chem_opt    , 1 , ierr )
 283     CALL wrf_put_dom_ti_integer ( id1 , 'ISWATER'         , iswater     , 1 , ierr )
 284     CALL wrf_put_dom_ti_integer ( id1 , 'ISICE  '         , isice       , 1 , ierr )
 285     CALL wrf_put_dom_ti_integer ( id1 , 'ISURBAN'         , isurban     , 1 , ierr )
 286     CALL wrf_put_dom_ti_integer ( id1 , 'ISOILWATER'      , isoilwater  , 1 , ierr )
 287     CALL wrf_put_dom_ti_char    ( id1 , 'MMINLU'          , TRIM(chlanduse)   , ierr )
 288
 289
 290    CALL close_dataset ( id1 , config_flags , "DATASET=AUXOUTPUT4" )
 291
 292    write(message,FMT='(A)') ' BIOGENIC EMISSIONS: end of program '
 293    CALL  wrf_message ( message )
 294
 295
 296     CALL wrf_shutdown
 297     CALL WRFU_Finalize( rc=rc )
 298
 299 !#ifdef DM_PARALLEL
 300 !   CALL wrf_dm_shutdown
 301 !#endif
 302
 303    STOP
 304
 305 END PROGRAM convert_bioemiss