Original WRF subgrid support version from John Michalakes without fire
[wrffire.git] / wrfv2_fire / chem / convert_bioemiss.F
blobb651e6ab4bad6c1418ba0ec59a1fa50e9c0aa70a
1 ! This is a program that converts biobenic emissions data 
2 !    into WRF input data.
5 PROGRAM convert_bioemiss
6 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
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
24 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
25    IMPLICIT NONE
27    INTERFACE
28      SUBROUTINE Setup_Timekeeping( grid )
29       USE module_domain
30       TYPE(domain), POINTER :: grid
31      END SUBROUTINE Setup_Timekeeping
32    END INTERFACE
34    REAL    :: time 
36    INTEGER :: loop , levels_to_process
37    INTEGER :: rc
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
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
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
59    CHARACTER (LEN=80)     :: message
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
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
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
75    CHARACTER (LEN=80) :: inpname , eminame, dum_str, wrfinname
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
84    !  Get the NAMELIST data for input.
86    !  Define the name of this program (program_name defined in module_domain)
88    program_name = "WRF V2.1.2 BIOGENIC EMISSIONS PREPROCESSOR"
90 #ifdef DM_PARALLEL
91    CALL disable_quilting
92 #endif
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)
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
113    CALL  wrf_message ( program_name )
115    CALL init_wrfio
117 !     !  Get the grid info from the wrfinput file
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 )
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 )
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 )
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 )
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 )
168       CALL close_dataset      ( fid , config_flags , "DATASET=INPUT" )
171    !  An available simple timer from the timing module.
173    CALL set_scalar_indices_from_config ( grid%id , idum1, idum2 )
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 )
182    CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
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
191    !  Figure out the starting and ending dates in a character format.
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)
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)
207    interval_seconds    = 3600
208    real_data_init_type = model_config_rec%real_data_init_type
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
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
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 )
234    grid%input_from_file = .false.
236    write(message,FMT='(A)') ' OPEN BIOGENIC EMISSIONS WRF file'
237    CALL  wrf_debug ( 100, message )
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
248    write(message,FMT='(A)') ' PAST OPEN BIOGENIC EMISSIONS WRF file '
249    CALL  wrf_debug ( 100, message )
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'
255       if( stand_lon  == 0. ) then
256          stand_lon = cen_lon
257       endif
259       if( moad_cen_lat  == 0. ) then
260          moad_cen_lat = cen_lat
261       endif
263    CALL output_aux_model_input4 ( id1 , grid , config_flags , ierr )
265    write(message,FMT='(A)') ' BIOGENIC EMISSIONS: fix global attributes '
266    CALL  wrf_debug ( 100, message )
268    ! write global atributes into wrf emissions file
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 )
290    CALL close_dataset ( id1 , config_flags , "DATASET=AUXOUTPUT4" )
292    write(message,FMT='(A)') ' BIOGENIC EMISSIONS: end of program '
293    CALL  wrf_message ( message )
296     CALL wrf_shutdown
297     CALL WRFU_Finalize( rc=rc )
299 !#ifdef DM_PARALLEL
300 !   CALL wrf_dm_shutdown
301 !#endif
303    STOP
305 END PROGRAM convert_bioemiss