! This program that converts the following emissions data into
! into WRF input data data files. The potential fields are:
! 1) anthropogenic emissions data
! 2) biogenic emissions data
! 3) GOCART dust errosion factor
! 4) GOCART sea salt emissions factor
! 5) GOCART dimethyl sulfide emissions
! 6) Wild fire biomass burn location obtained from GOES-ABBA data
!
! The WRF namelist.input file is used to decide which data
! is to be converted when this program is executed.
!
PROGRAM convert_emissions
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
USE module_machine
USE module_wrf_error
USE module_integrate
USE module_domain
! USE module_domain, ONLY : domain, alloc_and_configure_domain, &
! domain_clock_set, domain_clock_get, head_grid, program_name, domain_clockprint
! USE module_initialize_real, ONLY : wrfu_initialize, rebalance_driver, find_my_parent
USE module_driver_constants
USE module_configure, ONLY : grid_config_rec_type, model_config_rec, &
initial_config, get_config_as_buffer, set_config_as_buffer
USE module_io_domain
#ifdef DM_PARALLEL
USE module_dm
#endif
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!new for bc
USE module_bc
USE module_get_file_names
#if (EM_CORE ==1)
USE module_big_step_utilities_em
#endif
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
IMPLICIT NONE
INTERFACE
SUBROUTINE init_domain_constants_em_ptr ( parent , nest )
USE module_domain
USE module_configure
TYPE(domain), POINTER :: parent , nest
END SUBROUTINE init_domain_constants_em_ptr
END INTERFACE
INTERFACE
SUBROUTINE Setup_Timekeeping( grid )
USE module_domain
TYPE(domain), POINTER :: grid
END SUBROUTINE Setup_Timekeeping
END INTERFACE
INTEGER, PARAMETER :: rnum8=4
REAL :: time
INTEGER :: loop , levels_to_process
INTEGER :: rc
TYPE(domain) , POINTER :: keep_grid, grid_ptr, null_domain, grid, ingrid
TYPE (grid_config_rec_type) :: config_flags, config_flags_in
INTEGER :: number_at_same_level
INTEGER :: max_dom, domain_id
INTEGER :: id1, id , fid, ierr
INTEGER :: idum1, idum2 , ihour, icnt
#ifdef DM_PARALLEL
INTEGER :: nbytes
INTEGER, PARAMETER :: configbuflen = 4* CONFIG_BUF_LEN
INTEGER :: configbuf( configbuflen )
LOGICAL , EXTERNAL :: wrf_dm_on_monitor
#endif
REAL :: dt_from_file, tstart_from_file, tend_from_file
INTEGER :: ids , ide , jds , jde , kds , kde
INTEGER :: ips , ipe , jps , jpe , kps , kpe
INTEGER :: ims , ime , jms , jme , kms , kme
INTEGER :: i , j , k , idts, ntsd, emi_frame, nemi_frames
integer :: kw, kg
real :: top, bot,fac
INTEGER :: debug_level = 0
INTEGER, PARAMETER :: iklev=55
real,dimension(iklev) :: p_g,p_wrf
REAL :: p00, t00, a, p_surf, pd_surf,p_top
integer :: kbot,ktop,k_initial,k_final,kk4,ko,kl
REAL, ALLOCATABLE, DIMENSION(:) :: gocart_lev
REAL, ALLOCATABLE, DIMENSION(:,:) :: tmp2
REAL, ALLOCATABLE, DIMENSION(:,:,:) :: tmp_oh,tmp_no3,tmp_h2o2,tmp3,interpolate
REAL, ALLOCATABLE :: dumc0(:,:,:),dumc4(:,:,:),zlevel(:,:,:)
REAL, ALLOCATABLE :: dumc1(:,:)
real mmax
! Volcanic stuff
!
real, allocatable, dimension (:,:) :: ash_mass,ash_height,erup_dt
real, allocatable, dimension (:,:) :: so2_mass, volc_vent
real, allocatable, dimension (:) :: vert_mass_dist
real, dimension(10) :: size_dist
real :: x1,percen_mass_umbrel,base_umbrel,ashz_above_vent
#if (NMM_CORE == 1)
REAL, ALLOCATABLE :: plvl(:,:,:)
REAL, ALLOCATABLE :: pdsl(:,:)
#endif
CHARACTER (LEN=80) :: message
CHARACTER(LEN=24) :: previous_date , this_date , next_date
CHARACTER(LEN=19) :: start_date_char , end_date_char , current_date_char , next_date_char
CHARACTER(LEN= 4) :: loop_char
INTEGER :: start_year , start_month , start_day , start_hour , start_minute , start_second
INTEGER :: end_year , end_month , end_day , end_hour , end_minute , end_second
INTEGER :: interval_seconds , real_data_init_type
INTEGER :: int_sec
INTEGER :: time_loop_max , time_loop
REAL :: cen_lat, cen_lon, moad_cen_lat, truelat1, truelat2, gmt, stand_lon, dum1
INTEGER :: map_proj, julyr, julday, iswater, isice, isurban, isoilwater
! Add a logical leap-year variable as we want to calculate Julian day from the volc_d01 file
LOGICAL :: LEAP
! Add beg_yr, beg_mon, and beg_jul to calculate the eruption Julian day and hour from the
! volc_d01 data file as it can be different than the run start day and hour.
INTEGER :: iswaterr,itest,beg_yr,beg_mon,beg_jul,beg_day,beg_hour
INTEGER :: itime = 0
INTEGER :: inew_nei = 0
INTEGER :: inew_ch4 = 0 ! set to 1 if using 2011 NEI emissions
INTEGER :: nv = 0
INTEGER :: nv_f = 0
INTEGER :: nv_g = 0
INTEGER :: itime_f = 0
REAL :: dx,dy,area,eh
CHARACTER(LEN= 8) :: chlanduse
CHARACTER (LEN=80) :: inpname , eminame, dum_str, wrfinname
CHARACTER (LEN=80) :: bdyname, bdyname2
CHARACTER (LEN=20) :: dname
CHARACTER (LEN=12) :: dname2
CHARACTER (LEN=256) :: timestr
! MBO is separated, SESQ is added
! Number of reference emission and LAI files to open
INTEGER, PARAMETER :: numfil=21
INTEGER :: status,system
! Filenames of reference emissions and LAI
CHARACTER*100 onefil
CHARACTER*12 emfil(numfil)
DATA emfil/'ISO','OLI','API','LIM','XYL','HC3','ETE','OLT', &
'KET','ALD','HCHO','ETH','ORA2','CO','NR','SESQ','MBO', &
'NOAG_GROW','NOAG_NONGROW','NONONAG','ISOP'/
! these are needed on some compilers, eg compaq/alpha, to
! permit pass by reference through the registry generated
! interface to med_read_emissions, below
#ifdef DEREF_KLUDGE
INTEGER :: sm31 , em31 , sm32 , em32 , sm33 , em33
#endif
#include "version_decl"
#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * rnum8 )
! Get the NAMELIST data for input.
! Define the name of this program (program_name defined in module_domain)
program_name = "WRF-CHEM " // TRIM(release_version) // " EMISSIONS PREPROCESSOR"
#ifdef DM_PARALLEL
CALL disable_quilting
#endif
! CALL init_modules
CALL wrf_debug ( 100 , 'convert_emiss: calling init_modules ' )
CALL init_modules(1) ! Phase 1 returns after MPI_INIT() (if it is called)
#ifdef NO_LEAP_CALENDAR
CALL WRFU_Initialize( defaultCalKind=WRFU_CAL_NOLEAP, rc=rc )
#else
CALL WRFU_Initialize( defaultCalKind=WRFU_CAL_GREGORIAN, rc=rc )
#endif
CALL init_modules(2) ! Phase 2 resumes after MPI_INIT() (if it is called)
#ifdef DM_PARALLEL
IF ( wrf_dm_on_monitor() ) THEN
CALL initial_config
ENDIF
CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
CALL wrf_dm_bcast_bytes( configbuf, nbytes )
CALL set_config_as_buffer( configbuf, configbuflen )
CALL wrf_dm_initialize
#else
CALL initial_config
#endif
! And here is an instance of using the information in the NAMELIST.
CALL nl_get_debug_level ( 1, debug_level )
CALL set_wrf_debug_level ( debug_level )
! Allocated and configure the mother domain. Since we are in the nesting down
! mode, we know a) we got a nest, and b) we only got 1 nest.
NULLIFY( null_domain )
CALL wrf_message ( program_name )
write(message,FMT='(A)') ' allocate for wrfinput_d01 '
CALL alloc_and_configure_domain ( domain_id = 1 , &
grid = head_grid , &
parent = null_domain , &
kid = -1 )
grid => head_grid
! Set up time initializations.
CALL Setup_Timekeeping ( grid )
CALL domain_clock_set( head_grid, &
time_step_seconds=model_config_rec%interval_seconds )
CALL wrf_debug ( 100 , 'convert_gocart: calling model_to_grid_config_rec ' )
CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
CALL wrf_debug ( 100 , 'convert_gocart: calling set_scalar_indices_from_config ' )
CALL set_scalar_indices_from_config ( grid%id , idum1, idum2 )
! Initialize the I/O for WRF.
CALL wrf_debug ( 100 , 'convert_gocart: calling init_wrfio' )
CALL init_wrfio
#ifdef DM_PARALLEL
CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
CALL wrf_dm_bcast_bytes( configbuf, nbytes )
CALL set_config_as_buffer( configbuf, configbuflen )
#endif
! ! Get the grid info from the wrfinput file
CALL wrf_debug ( 100, message )
write(message,FMT='(A)') ' set scalars for wrfinput_d01 '
CALL wrf_debug ( 100, message )
CALL set_scalar_indices_from_config ( grid%id , idum1, idum2 )
write(message,FMT='(A)') ' construct filename for wrfinput_d01 '
CALL wrf_debug ( 100, message )
CALL construct_filename1( wrfinname , 'wrfinput' , grid%id , 2 )
write(message,FMT='(A,A)') ' open file ',TRIM(wrfinname)
CALL wrf_message ( message )
CALL open_r_dataset ( fid, TRIM(wrfinname) , head_grid , config_flags , "DATASET=INPUT", ierr )
! read wrfinput
!
CALL med_initialdata_input( head_grid , config_flags )
!
write(message,FMT='(A)') ' wrfinput open error check '
CALL wrf_debug ( 100, message )
IF ( ierr .NE. 0 ) THEN
WRITE( wrf_err_message , FMT='(A,A,A,I8)' ) &
'program convert_emiss: error opening ',TRIM(wrfinname),' for reading ierr=',ierr
CALL WRF_ERROR_FATAL ( wrf_err_message )
ENDIF
write(message,FMT='(A)') ' past opening wrfinput_d01 '
CALL wrf_debug ( 00, message )
CALL close_dataset ( fid , config_flags , "DATASET=INPUT" )
! An available simple timer from the timing module.
CALL set_scalar_indices_from_config ( grid%id , idum1, idum2 )
CALL Setup_Timekeeping ( grid )
CALL domain_clock_set( grid, &
time_step_seconds=model_config_rec%interval_seconds )
CALL domain_clock_get( grid, current_timestr=timestr )
write(message,FMT='(A,A)') ' current_time ',Trim(timestr)
CALL wrf_debug ( 100, message )
CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
! Figure out the starting and ending dates in a character format.
start_year = model_config_rec%start_year (grid%id)
start_month = model_config_rec%start_month (grid%id)
start_day = model_config_rec%start_day (grid%id)
start_hour = model_config_rec%start_hour (grid%id)
start_minute = model_config_rec%start_minute(grid%id)
start_second = model_config_rec%start_second(grid%id)
end_year = model_config_rec% end_year (grid%id)
end_month = model_config_rec% end_month (grid%id)
end_day = model_config_rec% end_day (grid%id)
end_hour = model_config_rec% end_hour (grid%id)
end_minute = model_config_rec% end_minute(grid%id)
end_second = model_config_rec% end_second(grid%id)
int_sec = 0
int_sec = config_flags%auxinput5_interval
if ( int_sec == 0 ) then
int_sec = config_flags%auxinput5_interval_s
endif
if ( int_sec == 0 ) then
int_sec = 60 * config_flags%auxinput5_interval_m
endif
if ( int_sec == 0 ) then
int_sec = 3600 * config_flags%auxinput5_interval_h
endif
if ( int_sec == 0 ) then
int_sec = 86400 * config_flags%auxinput5_interval_d
endif
CALL domain_clock_set( grid, &
time_step_seconds=int_Sec )
real_data_init_type = model_config_rec%real_data_init_type
WRITE ( start_date_char , FMT = '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
start_year,start_month,start_day,start_hour,start_minute,start_second
WRITE ( end_date_char , FMT = '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
end_year, end_month, end_day, end_hour, end_minute, end_second
print *,'START DATE ',start_date_char, int_sec, model_config_rec%interval_seconds
print *,'END DATE ',end_date_char
! these are needed on some compilers, eg compaq/alpha, to
! permit pass by reference through the registry generated
! interface to med_read_emissions, below
#ifdef DEREF_KLUDGE
sm31 = grid%sm31
em31 = grid%em31
sm32 = grid%sm32
em32 = grid%em32
sm33 = grid%sm33
em33 = grid%em33
#endif
CALL get_ijk_from_grid ( grid , &
ids, ide, jds, jde, kds, kde, &
ims, ime, jms, jme, kms, kme, &
ips, ipe, jps, jpe, kps, kpe )
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Allocate scratch arrays
!
ALLOCATE (dumc0(ids:ide,kds:grid%kemit,jds:jde))
! ALLOCATE (dumc4(ids:ide-1,kds:grid%kemit,jds:jde-1))
ALLOCATE (dumc1(ids:ide,jds:jde))
ALLOCATE( tmp_oh(ids:ide,jds:jde,iklev) )
ALLOCATE( tmp_h2o2(ids:ide,jds:jde,iklev) )
ALLOCATE( tmp_no3(ids:ide,jds:jde,iklev) )
ALLOCATE( tmp2(ids:ide,jds:jde) )
ALLOCATE( tmp3(ids:ide,jds:jde,3) )
ALLOCATE( interpolate(ids:ide,kds:kde,jds:jde) )
ALLOCATE( gocart_lev(iklev))
if(config_flags%emiss_opt_vol == 1 .or. config_flags%emiss_opt_vol == 2) then
ALLOCATE( ash_mass(ids:ide,jds:jde) )
ALLOCATE( so2_mass(ids:ide,jds:jde) )
ALLOCATE( volc_vent(ids:ide,jds:jde) )
ALLOCATE( ash_height(ids:ide,jds:jde) )
ALLOCATE( erup_dt(ids:ide,jds:jde) )
ALLOCATE( vert_mass_dist(kds:kde) )
ALLOCATE( zlevel(ids:ide,kds:kde,jds:jde) )
endif
ihour = start_hour
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! read reference fields that some of the GOCART modules require (can be run with other modules too?)
!
if(config_flags%chem_opt == GOCART_SIMPLE &
.or. config_flags%chem_opt == GOCARTRACM_KPP &
.or. config_flags%chem_opt == CHEM_VOLC &
.or. config_flags%dmsemis_opt == DMSGOCART &
.or. config_flags%dust_opt == DUSTGOCART &
) then
write(message,FMT='(A)') ' READ GOCART BACKGROUND DATA '
CALL wrf_debug ( 00, message )
!
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
OPEN(19,FILE='wrf_gocart_backg',FORM='UNFORMATTED')
endif
#else
OPEN(19,FILE='wrf_gocart_backg',FORM='UNFORMATTED')
#endif
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(19)tmp2(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(tmp2)
#else
print *,ids,ide,jds,jde
read(19)tmp2(ids:ide ,jds:jde )
#endif
grid%dms_0(ips:ipe,jps:jpe) = tmp2(ips:ipe,jps:jpe)
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(19)tmp3(ids:ide ,jds:jde ,1:3)
ENDIF
DM_BCAST_MACRO(tmp3)
#else
read(19)tmp3(ids:ide ,jds:jde ,1:3)
#endif
! do i=1,3
! grid%erod(ips:ipe,jps:jpe,i)=tmp3(ips:ipe,jps:jpe,i)
! enddo
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(19)gocart_lev(1:iklev)
ENDIF
DM_BCAST_MACRO(gocart_lev)
#else
read(19)gocart_lev(1:iklev)
#endif
write(*,*) 'GOCART_LEV: ',gocart_lev(:)
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(19)tmp_h2o2(ids:ide,jds:jde,1:iklev)
ENDIF
DM_BCAST_MACRO(tmp_h2o2)
#else
read(19)tmp_h2o2(ids:ide,jds:jde,1:iklev)
#endif
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(19)tmp_oh(ids:ide,jds:jde,1:iklev)
ENDIF
DM_BCAST_MACRO(tmp_oh)
#else
read(19)tmp_oh(ids:ide,jds:jde,1:iklev)
#endif
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(19)tmp_no3(ids:ide,jds:jde,1:iklev)
ENDIF
DM_BCAST_MACRO(tmp_no3)
#else
read(19)tmp_no3(ids:ide,jds:jde,1:iklev)
#endif
CLOSE(19)
! CALL input_ext_chem_gocart_bg ( grid )
write(message,FMT='(A)') ' PAST GOCART BACKGROUND DATA'
CALL wrf_debug ( 00, message )
grid%input_from_file = .false.
write(message,FMT='(A)') ' OPEN GOCART BACKGROUND DATA WRF file'
CALL wrf_debug ( 00, message )
CALL construct_filename1( inpname , 'wrfchemi_gocart_bg' , grid%id , 2 )
CALL open_w_dataset ( id1, TRIM(inpname) , grid , config_flags , output_auxinput8 , "DATASET=AUXINPUT8", ierr )
write(message,FMT='(A,A)') ' GOCART BACKGROUND DATA file name: ',TRIM(inpname)
CALL wrf_message ( message )
IF ( ierr .NE. 0 ) THEN
CALL wrf_error_fatal( 'convert_emiss: error opening wrfchem emissions file for writing' )
ENDIF
write(message,FMT='(A)') ' PAST OPEN GOCART BACKGROUND DATA WRF file '
CALL wrf_debug ( 100, message )
CALL calc_current_date ( grid%id , 0. )
CALL geth_newdate ( current_date_char, current_date, 3600 )
current_date = current_date_char // '.0000'
! if( stand_lon == 0. ) then
! stand_lon = cen_lon
! endif
! if( moad_cen_lat == 0. ) then
! moad_cen_lat = cen_lat
! endif
idum1 = 1
IF( (config_flags%chem_opt == GOCART_SIMPLE) .OR. &
(config_flags%chem_opt == CHEM_VOLC) .OR. &
(config_flags%chem_opt == GOCARTRACM_KPP) ) then
! interpolate 3d fields to WRF in vertical
!
do k=1,iklev
p_g(k) = log10( gocart_lev(k) * 1023.)
enddo
CALL nl_get_base_pres ( 1 , p00 )
CALL nl_get_base_temp ( 1 , t00 )
CALL nl_get_base_lapse ( 1 , a )
call nl_get_p_top_requested (1,p_top)
t00=290.
a=50.
! p00=100000.
! p_top=5000.
#if (EM_CORE == 1)
do j=jps,jpe
do i=ips,ipe
p_surf = p00 * EXP ( -t00/a + ( (t00/a)**2 - 2.*g*grid%ht(i,j)/a/r_d ) **0.5 )
do k=kps,kpe
grid%pb(i,k,j) = grid%znu(k)*(p_surf - p_top) + p_top
enddo
do kw=kpe-1,kps,-1
do kg=iklev-1,1,-1
if( p_g(kg) <= log10(.01*grid%pb(i,kw,j)) ) then
kbot = max(1,kg-1)
ktop = max(min(kg,iklev-1),2)
endif
enddo ! kg loop
fac= (tmp_no3(i ,j ,ktop)-tmp_no3(i ,j ,kbot))/ (p_g(ktop) - p_g(kbot))
grid%backg_no3(i, kw, j) = tmp_no3(i ,j ,kbot)+fac*(log10(.01*grid%pb(i,kw,j))-p_g(kbot))
! OH
fac= (tmp_oh(i ,j ,ktop)-tmp_oh(i ,j ,kbot))/ (p_g(ktop) - p_g(kbot))
grid%backg_oh(i, kw, j) = tmp_oh(i ,j ,kbot)+fac*(log10(.01*grid%pb(i,kw,j))-p_g(kbot))
! H2O2
fac= (tmp_h2o2(i ,j ,ktop)-tmp_h2o2(i ,j ,kbot) )/(p_g(ktop) - p_g(kbot))
grid%backg_h2o2(i, kw, j) = tmp_h2o2(i ,j ,kbot)+fac*(log10(.01*grid%pb(i,kw,j))-p_g(kbot))
enddo ! kw loop
enddo
enddo
#endif
#if ( NMM_CORE == 1 )
! Get scalar grid point heights
ALLOCATE( plvl(ips:ipe,kps:kpe,jps:jpe) )
ALLOCATE( pdsl(ips:ipe,jps:jpe) )
IF(grid%sigma.EQ. 1)THEN
do j=jps,jpe
do i=ips,ipe
pdsl(i,j)=grid%pd(i,j)
ENDDO
ENDDO
ELSE
do j=jps,jpe
do i=ips,ipe
pdsl(i,j)=grid%res(i,j)*grid%pd(i,j)
enddo
enddO
ENDIF
do j=jps,jpe
do k=kps,kpe
do i=ips,ipe
plvl(i,k,j)=grid%eta1(k)*grid%pdtop+grid%eta2(k)*pdsl(i,j)+grid%pt
ENDDO
ENDDO
ENDDO
do j=jps,jpe
do i=ips,ipe
do kw=kpe-1,kps,-1
do kg=iklev-1,1,-1
if( p_g(kg) <= log10(.01*plvl(i,kw,j)) ) then
kbot = max(1,kg-1)
ktop = max(min(kg,iklev-1),2)
endif
enddo ! kg loop
fac= (tmp_no3(i ,j ,ktop)-tmp_no3(i ,j ,kbot))/ (p_g(ktop) - p_g(kbot))
grid%backg_no3(i, kw, j) = tmp_no3(i ,j ,kbot)+fac*(log10(.01*plvl(i,kw,j))-p_g(kbot))
! OH
fac= (tmp_oh(i ,j ,ktop)-tmp_oh(i ,j ,kbot))/ (p_g(ktop) - p_g(kbot))
grid%backg_oh(i, kw, j) = tmp_oh(i ,j ,kbot)+fac*(log10(.01*plvl(i,kw,j))-p_g(kbot))
! H2O2
fac= (tmp_h2o2(i ,j ,ktop)-tmp_h2o2(i ,j ,kbot) )/(p_g(ktop) - p_g(kbot))
grid%backg_h2o2(i, kw, j) = tmp_h2o2(i ,j ,kbot)+fac*(log10(.01*plvl(i,kw,j))-p_g(kbot))
enddo ! kw loop
enddo
enddo
#endif
ENDIF ! chem_opt gocart_simple or gocartracm
CALL output_auxinput8 ( id1 , grid , config_flags , ierr )
CALL close_dataset ( id1 , config_flags , "DATASET=AUXOUTPUT8" )
ENDIF ! chem_opt gocart_simple,dmsgocart,dustgocart
DEALLOCATE( tmp_oh )
DEALLOCATE( tmp_h2o2 )
DEALLOCATE( tmp_no3 )
DEALLOCATE( tmp2)
DEALLOCATE( tmp3)
DEALLOCATE( interpolate )
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Volcanic emissions
if(config_flags%emiss_opt_vol == 1 .or. config_flags%emiss_opt_vol == 2) then
write(message, FMT='(A,4I6)') ' I am reading global volcanic emissions, dims: =',ids, ide-1, jds, jde-1
call wrf_message( TRIM( message ) )
CALL construct_filename1 ( bdyname , 'volc' , grid%id , 2 )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
open (92,file=bdyname,form='unformatted')
ENDIf
#else
OPEN(92,FILE=bdyname,FORM='UNFORMATTED')
#endif
write(message, FMT='(A,A)') ' OPENED FILE: ',TRIM(bdyname)
call wrf_message( TRIM( message ) )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(92)nv_g
read(92)dname
read(92)dname2
CALL wrf_dm_bcast_bytes ( nv_g , rnum8 )
CALL wrf_dm_bcast_bytes ( dname , rnum8 )
CALL wrf_dm_bcast_bytes ( dname2 , rnum8 )
ENDIF
#else
read(92)nv_g
read(92)dname
read(92)dname2
#endif
CALL geth_julgmt ( config_flags%julyr , config_flags%julday , config_flags%gmt )
! dname = YYYYMMDDHHMMSS
! 12345678901234
! read in the eruption beg_yr and beg_mon from the volc_d01 data file
read(unit=dname2(1:4), FMT='(I4)')beg_yr
read(unit=dname2(5:6), FMT='(I2)')beg_mon
read(unit=dname2(7:8), FMT='(I2)')beg_day
read(unit=dname2(9:10), FMT='(I2)')beg_hour
!
! convert the date from the volc_d01 data file to Julian day
LEAP = .FALSE.
IF((MOD(beg_yr,4) .EQ. 0 .AND. MOD(beg_yr,100).NE.0 ).OR. MOD(beg_yr,400).EQ.0 ) THEN
LEAP = .TRUE.
ENDIF
IF (LEAP) THEN
K = 1
ELSE
K = 2
END IF
beg_jul = ((275*beg_mon)/9) - K*((beg_mon+9)/12) + beg_day - 30
write(0,*)' DNAME2 = ',dname2,beg_jul,beg_hour
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(92)size_dist
ENDIF
DM_BCAST_MACRO(size_dist)
! write(0,*)size_dist
#else
read(92)size_dist
#endif
! write(0,*)'size_dist = ',size_dist,ids,ide,jds,jde
if(config_flags%emiss_opt_vol == 2 ) then
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
! write(0,*)'now do so2 '
read(92)so2_mass(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(so2_mass)
! write(0,*)maxval(so2_mass)
#else
! write(0,*)'now do so2-s '
read(92)so2_mass(ids:ide ,jds:jde )
#endif
endif ! config_flags%emiss_opt_vol == 2
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
write(0,*)'now do ash mass '
read(92)ash_mass(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(ash_mass)
#else
read(92)ash_mass(ids:ide ,jds:jde )
#endif
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
write(0,*)'now do ash heigt '
read(92)ash_height(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(ash_height)
#else
read(92)ash_height(ids:ide ,jds:jde )
#endif
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
! write(0,*)'now do volc vent '
read(92)volc_vent(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(volc_vent)
! write(0,*)maxval(volc_vent)
#else
read(92)volc_vent(ids:ide ,jds:jde )
#endif
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
write(0,*)'now do erup dt '
read(92)erup_dt(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(erup_dt)
#else
read(92)erup_dt(ids:ide ,jds:jde )
#endif
do j=jps,jpe
do k=kps,kpe
do i=ips,ipe
zlevel(i,k,j) = (grid%phb(i,k,j)+grid%ph_2(i,k,j))/9.81
enddo
enddo
enddo
percen_mass_umbrel=.75
base_umbrel=.25 ! fraction
do j=jps,jpe
do i=ips,ipe
if(ash_height(i,j).le.0.)CYCLE
area = config_flags%dx * config_flags%dy
! so2_mass=1.5e4*3600.*1.e9/64./area
eh=2600.*(ash_height(i,j)*.0005)**4.1494
ash_mass(i,j)=eh*1.e9/area
! if(erup_dt(i,j).le.0.)CYCLE
ashz_above_vent=ash_height(i,j)+volc_vent(i,j) !zlevel(i,kps,j)
! ashz_above_vent=ash_height(i,j)+zlevel(i,kps,j)
! write(0,*)'found active volcano at i,j,kps,kpe = ',i,j,kps,kpe
! write(0,*)ash_height(i,j),ash_mass(i,j),erup_dt(i,j),ashz_above_vent
do k=kpe-1,kps,-1
! write(0,*)k,zlevel(i,k,j)
if(zlevel(i,k,j) < ashz_above_vent)then
k_final=k+1
exit
endif
enddo
! write(0,*)'k_final = ',k_final
do k=kpe-1,kps,-1
! write(0,*)k,zlevel(i,k,j)
if(zlevel(i,k,j) < (1.-base_umbrel)*ashz_above_vent)then
k_initial=k
exit
endif
enddo
! write(0,*)'k_init = ',k_initial
vert_mass_dist=0.
!- parabolic vertical distribution between k_initial and k_final
kk4 = k_final-k_initial+2
do ko=1,kk4-1
kl=ko+k_initial-1
vert_mass_dist(kl) = 6.*percen_mass_umbrel* float(ko)/float(kk4)**2 * (1. - float(ko)/float(kk4))
enddo
! write(0,*)' mass=',sum(vert_mass_dist)*100.
if(sum(vert_mass_dist(kps:kpe)) .ne. percen_mass_umbrel) then
x1= ( percen_mass_umbrel- sum(vert_mass_dist(kps:kpe)) )/float(k_final-k_initial+1)
do ko=k_initial,k_final
vert_mass_dist(ko) = vert_mass_dist(ko)+ x1 !- values between 0 and 1.
enddo
! print*,'new mass=',sum(vmd)*100.,x1
!pause
endif
!k_final > 0 .and. k_initial >
!linear detrainment from vent to base of umbrella
do ko=1,k_initial-1
vert_mass_dist(ko)=float(ko)/float(k_initial-1)
enddo
x1=sum(vert_mass_dist(1:k_initial-1))
do ko=1,k_initial-1
vert_mass_dist(ko)=(1.-percen_mass_umbrel)*vert_mass_dist(ko)/x1
enddo
do ko=1,k_final
! vert_mass_dist(ko) = vert_mass_dist(ko)+ x1 !- values between 0 and 1.
! write(0,*)'k,vert_mass_dist = ',ko,vert_mass_dist(ko),zlevel(i,ko,j)
grid%emis_vol(i,ko,j,p_e_vash1)=size_dist(1)*vert_mass_dist(ko)*ash_mass(i,j)
grid%emis_vol(i,ko,j,p_e_vash2)=size_dist(2)*vert_mass_dist(ko)*ash_mass(i,j)
grid%emis_vol(i,ko,j,p_e_vash3)=size_dist(3)*vert_mass_dist(ko)*ash_mass(i,j)
grid%emis_vol(i,ko,j,p_e_vash4)=size_dist(4)*vert_mass_dist(ko)*ash_mass(i,j)
grid%emis_vol(i,ko,j,p_e_vash5)=size_dist(5)*vert_mass_dist(ko)*ash_mass(i,j)
grid%emis_vol(i,ko,j,p_e_vash6)=size_dist(6)*vert_mass_dist(ko)*ash_mass(i,j)
grid%emis_vol(i,ko,j,p_e_vash7)=size_dist(7)*vert_mass_dist(ko)*ash_mass(i,j)
grid%emis_vol(i,ko,j,p_e_vash8)=size_dist(8)*vert_mass_dist(ko)*ash_mass(i,j)
grid%emis_vol(i,ko,j,p_e_vash9)=size_dist(9)*vert_mass_dist(ko)*ash_mass(i,j)
grid%emis_vol(i,ko,j,p_e_vash10)=size_dist(10)*vert_mass_dist(ko)*ash_mass(i,j)
if(config_flags%emiss_opt_vol == 2)grid%emis_vol(i,ko,j,p_e_vso2)=vert_mass_dist(ko)*so2_mass(i,j)
enddo
! Changes made to Julian day from the volc_d01 file
grid%erup_beg(i,j)=float(beg_jul)*1000.+float(beg_hour)
grid%erup_end(i,j)=grid%erup_beg(i,j)+erup_dt(i,j)
write(0,*)'new mass=',sum(vert_mass_dist)*100.,x1
! endif
enddo
enddo
!
! simple file dump here....
!
write(message,FMT='(A)') ' OPEN EMISSIONS WRF file for emissions coming from volcano data set'
call wrf_message( TRIM( message ) )
write(message, FMT='(A)') ' NO TIME DEPENDENCE IN THIS DATASET'
! emissions from volcanoes (prep_chem_sources)
!
CALL construct_filename1( inpname , 'wrfchemv' , grid%id , 2 )
CALL open_w_dataset ( id1, TRIM(inpname) , grid , config_flags , output_auxinput13, "DATASET=AUXINPUT13", ierr )
CALL output_auxinput13( id1 , grid , config_flags , ierr )
CALL close_dataset ( id1 , config_flags , "DATASET=AUXOUTPUT13" )
endif
!!!!!!!!!!!!!!!!!!!! end volcanic stuff
!
if(config_flags%emiss_opt_vol == 1 .or. config_flags%emiss_opt_vol == 2) then
DEALLOCATE( ash_mass )
DEALLOCATE( so2_mass )
DEALLOCATE( volc_vent )
DEALLOCATE( ash_height )
DEALLOCATE( erup_dt)
DEALLOCATE( zlevel)
DEALLOCATE( vert_mass_dist)
endif
!
! now do fire and/or global emissions
!
if(config_flags%emiss_opt == ecptec .or. config_flags%emiss_opt == gocart_ecptec ) then
write(message, FMT='(A,4I6)') ' I am reading global anthropogenic emissions, dims: =',ids, ide-1, jds, jde-1
call wrf_message( TRIM( message ) )
CALL construct_filename1 ( bdyname , 'emissopt3' , grid%id , 2 )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
open (92,file=bdyname,form='unformatted')
ENDIf
#else
OPEN(92,FILE=bdyname,FORM='UNFORMATTED')
#endif
write(message, FMT='(A,A)') ' OPENED FILE: ',TRIM(bdyname)
call wrf_message( TRIM( message ) )
itest=0
if(config_flags%emiss_opt == ecptec)itest=1
if(config_flags%emiss_opt == gocart_ecptec)then
itest=0
write(message, FMT='(A)') ' I am reading emissions for gocart only (aerosols)'
call wrf_message( TRIM( message ) )
endif
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(92)nv_g
read(92)dname
read(92)itime
ENDIF
CALL wrf_dm_bcast_bytes ( nv_g , rnum8 )
CALL wrf_dm_bcast_bytes ( dname , rnum8 )
CALL wrf_dm_bcast_bytes ( itime , rnum8 )
#else
read(92)nv_g
read(92)dname
read(92)itime
#endif
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(92)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(92)dumc1(ids:ide ,jds:jde )
#endif
grid%emis_ant(ips:ipe ,kps,jps:jpe ,p_e_so2)=dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(92)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(92)dumc1(ids:ide ,jds:jde )
#endif
if(itest.eq.1)grid%emis_ant(ips:ipe ,kps,jps:jpe ,p_e_no2)=dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(92)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(92)dumc1(ids:ide ,jds:jde )
#endif
if(itest.eq.1)grid%emis_ant(ips:ipe ,kps,jps:jpe ,p_e_no)=dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(92)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(92)dumc1(ids:ide ,jds:jde )
#endif
if(itest.eq.1)grid%emis_ant(ips:ipe ,kps,jps:jpe ,p_e_ald)=dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(92)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(92)dumc1(ids:ide ,jds:jde )
#endif
if(itest.eq.1)grid%emis_ant(ips:ipe ,kps,jps:jpe ,p_e_hcho)=dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(92)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(92)dumc1(ids:ide ,jds:jde )
#endif
if(itest.eq.1)grid%emis_ant(ips:ipe ,kps,jps:jpe ,p_e_ora2)=dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(92)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(92)dumc1(ids:ide ,jds:jde )
#endif
if(itest.eq.1)grid%emis_ant(ips:ipe ,kps,jps:jpe ,p_e_nh3)=dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(92)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(92)dumc1(ids:ide ,jds:jde )
#endif
if(itest.eq.1)grid%emis_ant(ips:ipe ,kps,jps:jpe ,p_e_hc3)=dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(92)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(92)dumc1(ids:ide ,jds:jde )
#endif
if(itest.eq.1)grid%emis_ant(ips:ipe ,kps,jps:jpe ,p_e_hc5)=dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(92)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(92)dumc1(ids:ide ,jds:jde )
#endif
if(itest.eq.1)grid%emis_ant(ips:ipe ,kps,jps:jpe ,p_e_hc8)=dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(92)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(92)dumc1(ids:ide ,jds:jde )
#endif
if(itest.eq.1)grid%emis_ant(ips:ipe ,kps,jps:jpe ,p_e_eth)=dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(92)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(92)dumc1(ids:ide ,jds:jde )
#endif
if(itest.eq.1)grid%emis_ant(ips:ipe ,kps,jps:jpe ,p_e_co)=dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(92)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(92)dumc1(ids:ide ,jds:jde )
#endif
if(itest.eq.1)grid%emis_ant(ips:ipe ,kps,jps:jpe ,p_e_ol2)=dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(92)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(92)dumc1(ids:ide ,jds:jde )
#endif
if(itest.eq.1)grid%emis_ant(ips:ipe ,kps,jps:jpe ,p_e_olt)=dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(92)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(92)dumc1(ids:ide ,jds:jde )
#endif
if(itest.eq.1)grid%emis_ant(ips:ipe ,kps,jps:jpe ,p_e_oli)=dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(92)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(92)dumc1(ids:ide ,jds:jde )
#endif
if(itest.eq.1)grid%emis_ant(ips:ipe ,kps,jps:jpe ,p_e_tol)=dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(92)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(92)dumc1(ids:ide ,jds:jde )
#endif
if(itest.eq.1)grid%emis_ant(ips:ipe ,kps,jps:jpe ,p_e_xyl)=dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(92)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(92)dumc1(ids:ide ,jds:jde )
#endif
if(itest.eq.1)grid%emis_ant(ips:ipe ,kps,jps:jpe ,p_e_ket)=dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(92)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(92)dumc1(ids:ide ,jds:jde )
#endif
if(itest.eq.1)grid%emis_ant(ips:ipe ,kps,jps:jpe ,p_e_csl)=dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(92)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(92)dumc1(ids:ide ,jds:jde )
#endif
if(itest.eq.1)grid%emis_ant(ips:ipe ,kps,jps:jpe ,p_e_iso)=dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(92)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(92)dumc1(ids:ide ,jds:jde )
#endif
grid%emis_ant(ips:ipe ,kps,jps:jpe ,p_e_pm_25)=dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(92)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(92)dumc1(ids:ide ,jds:jde )
#endif
grid%emis_ant(ips:ipe ,kps,jps:jpe ,p_e_pm_10)=dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(92)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(92)dumc1(ids:ide ,jds:jde )
#endif
grid%emis_ant(ips:ipe ,kps,jps:jpe ,p_e_oc)=dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(92)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(92)dumc1(ids:ide ,jds:jde )
#endif
grid%emis_ant(ips:ipe ,kps,jps:jpe ,p_e_bc)=dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(92)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(92)dumc1(ids:ide ,jds:jde )
#endif
! grid%emis_ant(ips:ipe ,kps,jps:jpe ,p_e_dms)=dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(92)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(92)dumc1(ids:ide ,jds:jde )
#endif
grid%emis_ant(ips:ipe ,kps,jps:jpe ,p_e_sulf)=dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(92)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(92)dumc1(ids:ide ,jds:jde )
#endif
! grid%emis_ant(ips:ipe ,kps,jps:jpe ,p_e_ash)=dumc1(ips:ipe ,jps:jpe )
CLOSE(92)
!
! simple file dump here....
!
write(message,FMT='(A)') ' OPEN EMISSIONS WRF files for emissions coming from global data set'
call wrf_message( TRIM( message ) )
write(message, FMT='(A)') ' NO TIME DEPENDENCE IN THIS DATASET'
!
! emissions from retro/edgar/gocart
!
CALL construct_filename1( inpname , 'wrfchemi' , grid%id , 2 )
CALL open_w_dataset ( id1, TRIM(inpname) , grid , config_flags , output_auxinput5 , "DATASET=AUXINPUT5", ierr )
CALL output_auxinput5 ( id1 , grid , config_flags , ierr )
CALL close_dataset ( id1 , config_flags , "DATASET=AUXOUTPUT5" )
endif ! emiss_opt = ecptec or gocart_ecptec
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
if(config_flags%biomass_burn_opt == biomassb ) then
CALL construct_filename1 ( bdyname2 , 'emissfire' , grid%id , 2 )
write(message, FMT='(A,A)') ' TRY TO OPEN FILE: ',TRIM(bdyname2)
call wrf_message( TRIM( message ) )
CALL wrf_debug( 00 , 'calling fire emissions' )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
open (93,file=bdyname2,form='unformatted',status='old')
ENDIf
#else
OPEN(93,FILE=bdyname2,FORM='UNFORMATTED',status='old')
#endif
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(93)nv_f
read(93)dname
read(93)itime_f
ENDIF
CALL wrf_dm_bcast_bytes ( nv_f , rnum8 )
CALL wrf_dm_bcast_bytes ( dname , rnum8 )
CALL wrf_dm_bcast_bytes ( itime_f , rnum8 )
#else
read(93)nv_f
read(93)dname
read(93)itime_f
#endif
write(message, FMT='(A,I10)') ' Number of fire emissions: ',nv_f
call wrf_message( TRIM( message ) )
write(message, '(A,I8,A,I8)') ' FIRE EMISSIONS INPUT FILE TIME PERIOD (GMT): ',itime_f-1,' TO ',itime_f
call wrf_message( TRIM( message ) )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(93)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(93)dumc1(ids:ide ,jds:jde )
#endif
! write(*,*) 'MAXVAL2 ',MAXVAL(dumc1(:,:))
! write(*,*) 'MINVAL2 ',MINVAL(dumc1(:,:))
write(message, FMT='(A)') ' put dumc1 into ebu_in_so2'
call wrf_debug(100, TRIM( message ) )
grid%ebu_in(ips:ipe,1, jps:jpe ,p_ebu_in_so2) =dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(93)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(93)dumc1(ids:ide ,jds:jde )
#endif
grid%ebu_in(ips:ipe,1, jps:jpe ,p_ebu_in_no2) =dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(93)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(93)dumc1(ids:ide ,jds:jde )
#endif
grid%ebu_in(ips:ipe,1, jps:jpe ,p_ebu_in_no) =dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(93)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(93)dumc1(ids:ide ,jds:jde )
#endif
grid%ebu_in(ips:ipe,1, jps:jpe ,p_ebu_in_ald) =dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(93)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(93)dumc1(ids:ide ,jds:jde )
#endif
grid%ebu_in(ips:ipe,1, jps:jpe ,p_ebu_in_hcho) =dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(93)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(93)dumc1(ids:ide ,jds:jde )
#endif
grid%ebu_in(ips:ipe,1, jps:jpe ,p_ebu_in_ora2) =dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(93)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(93)dumc1(ids:ide ,jds:jde )
#endif
! grid%ebu_in(ips:ipe,1, jps:jpe ,p_ebu_in_nh3) =dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(93)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(93)dumc1(ids:ide ,jds:jde )
#endif
grid%ebu_in(ips:ipe,1, jps:jpe ,p_ebu_in_hc3) =dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(93)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(93)dumc1(ids:ide ,jds:jde )
#endif
grid%ebu_in(ips:ipe,1, jps:jpe ,p_ebu_in_hc5) =dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(93)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(93)dumc1(ids:ide ,jds:jde )
#endif
grid%ebu_in(ips:ipe,1, jps:jpe ,p_ebu_in_hc8) =dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(93)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(93)dumc1(ids:ide ,jds:jde )
#endif
grid%ebu_in(ips:ipe,1, jps:jpe ,p_ebu_in_eth) =dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(93)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(93)dumc1(ids:ide ,jds:jde )
#endif
grid%ebu_in(ips:ipe,1, jps:jpe ,p_ebu_in_co) =dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(93)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(93)dumc1(ids:ide ,jds:jde )
#endif
! grid%ebu_in(ips:ipe,1, jps:jpe ,p_ebu_in_ol2) =dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(93)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(93)dumc1(ids:ide ,jds:jde )
#endif
grid%ebu_in(ips:ipe,1, jps:jpe ,p_ebu_in_olt) =dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(93)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(93)dumc1(ids:ide ,jds:jde )
#endif
grid%ebu_in(ips:ipe,1, jps:jpe ,p_ebu_in_oli) =dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(93)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(93)dumc1(ids:ide ,jds:jde )
#endif
grid%ebu_in(ips:ipe,1, jps:jpe ,p_ebu_in_tol) =dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(93)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(93)dumc1(ids:ide ,jds:jde )
#endif
grid%ebu_in(ips:ipe,1, jps:jpe ,p_ebu_in_xyl) =dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(93)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(93)dumc1(ids:ide ,jds:jde )
#endif
grid%ebu_in(ips:ipe,1, jps:jpe ,p_ebu_in_ket) =dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(93)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(93)dumc1(ids:ide ,jds:jde )
#endif
grid%ebu_in(ips:ipe,1, jps:jpe ,p_ebu_in_csl) =dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(93)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(93)dumc1(ids:ide ,jds:jde )
#endif
grid%ebu_in(ips:ipe,1, jps:jpe ,p_ebu_in_iso) =dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(93)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(93)dumc1(ids:ide ,jds:jde )
#endif
grid%ebu_in(ips:ipe,1, jps:jpe ,p_ebu_in_pm25) =dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(93)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(93)dumc1(ids:ide ,jds:jde )
#endif
grid%ebu_in(ips:ipe,1, jps:jpe ,p_ebu_in_pm10) =dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(93)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(93)dumc1(ids:ide ,jds:jde )
#endif
grid%ebu_in(ips:ipe,1, jps:jpe ,p_ebu_in_oc) =dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(93)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(93)dumc1(ids:ide ,jds:jde )
#endif
grid%ebu_in(ips:ipe,1, jps:jpe ,p_ebu_in_bc) =dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(93)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(93)dumc1(ids:ide ,jds:jde )
#endif
grid%ebu_in(ips:ipe,1, jps:jpe ,p_ebu_in_dms) =dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(93)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(93)dumc1(ids:ide ,jds:jde )
#endif
grid%ebu_in(ips:ipe,1, jps:jpe ,p_ebu_in_sulf) =dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(93)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(93)dumc1(ids:ide ,jds:jde )
#endif
grid%ebu_in(ips:ipe,1, jps:jpe ,p_ebu_in_ash) =dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(93)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(93)dumc1(ids:ide ,jds:jde )
#endif
grid%mean_fct_agtf(ips:ipe ,jps:jpe )=dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(93)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(93)dumc1(ids:ide ,jds:jde )
#endif
grid%mean_fct_agef(ips:ipe ,jps:jpe )=dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(93)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(93)dumc1(ids:ide ,jds:jde )
#endif
grid%mean_fct_agsv(ips:ipe ,jps:jpe )=dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(93)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(93)dumc1(ids:ide ,jds:jde )
#endif
grid%mean_fct_aggr(ips:ipe ,jps:jpe )=dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(93)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(93)dumc1(ids:ide ,jds:jde )
#endif
grid%firesize_agtf(ips:ipe ,jps:jpe )=dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(93)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(93)dumc1(ids:ide ,jds:jde )
#endif
grid%firesize_agef(ips:ipe ,jps:jpe )=dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(93)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(93)dumc1(ids:ide ,jds:jde )
#endif
grid%firesize_agsv(ips:ipe ,jps:jpe )=dumc1(ips:ipe ,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(93)dumc1(ids:ide ,jds:jde )
ENDIF
DM_BCAST_MACRO(dumc1)
#else
read(93)dumc1(ids:ide ,jds:jde )
#endif
grid%firesize_aggr(ips:ipe ,jps:jpe )=dumc1(ips:ipe ,jps:jpe )
!
CLOSE(93)
!
! fire stuff
!
CALL construct_filename1( inpname , 'wrffirechemi' , grid%id , 2 )
write(message, FMT='(A,A)') ' NOW OPEN FILE FOR WRITE: ',TRIM(inpname)
call wrf_message( TRIM( message ) )
CALL open_w_dataset ( id1, TRIM(inpname) , grid , config_flags , output_auxinput7 , "DATASET=AUXINPUT7", ierr )
write(message,FMT='(A,A)') ' FIRE EMISSIONS OUTPUT file name: ',TRIM(inpname)
CALL wrf_message ( message )
IF ( ierr .NE. 0 ) THEN
write(message, FMT='(A,I10)') ' convert_emiss: error opening wrfchem fire emissions file for writing',ierr
CALL wrf_error_fatal( TRIM( message ) )
ENDIF
CALL output_auxinput7 ( id1 , grid , config_flags , ierr )
CALL close_dataset ( id1 , config_flags , "DATASET=AUXOUTPUT7" )
endif ! biomassburn
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! NOW DO BIG TIMEDEPENDENT EMISSIONS FILE
!
if(CONFIG_FLAGS%EMISS_OPT == ECBMZ_MOSAIC ) then
write(message, FMT='(A,I10)') ' convert_emiss: error: conversion for all CBMZ emission arrays not available '
CALL wrf_error_fatal( TRIM( message ) )
endif
if(CONFIG_FLAGS%EMISS_OPT == ERADM .or. CONFIG_FLAGS%EMISS_OPT == ERADMSORG .or. &
CONFIG_FLAGS%EMISS_OPT == MOZEM .or. CONFIG_FLAGS%EMISS_OPT == MOZCEM .or. &
CONFIG_FLAGS%EMISS_OPT == ECBMZ_MOSAIC ) then
! Figure out our loop count for the processing times.
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
#endif
time_loop = 1
write(message,FMT='(A,I4,A,A)') 'Time period #',time_loop,' to process = ',start_date_char
CALL wrf_message ( message )
current_date_char = start_date_char
loop_count : DO
CALL geth_newdate ( next_date_char , current_date_char , int_sec )
IF ( next_date_char .LT. end_date_char ) THEN
time_loop = time_loop + 1
write(message,FMT='(A,I4,A,A)') 'Time period #',time_loop,' to process = ',next_date_char
CALL wrf_message ( message )
current_date_char = next_date_char
ELSE IF ( next_date_char .EQ. end_date_char ) THEN
time_loop = time_loop + 1
write(message,FMT='(A,I4,A,A)') 'Time period #',time_loop,' to process = ',next_date_char
CALL wrf_message ( message )
write(message,FMT='(A,I4)') 'Total analysis times to input = ',time_loop
CALL wrf_message ( message )
time_loop_max = time_loop
EXIT loop_count
ELSE IF ( next_date_char .GT. end_date_char ) THEN
write(message,FMT='(A,I4)') 'Total analysis times to input = ',time_loop
CALL wrf_message ( message )
time_loop_max = time_loop
time_loop_max = time_loop
EXIT loop_count
END IF
END DO loop_count
write(message,FMT='(A,I4,A,I4)') 'Total number of times to input = ',time_loop,' ',time_loop_max
CALL wrf_message ( message )
#ifdef DM_PARALLEL
ENDIF
CALL wrf_dm_bcast_bytes ( time_loop , rnum8 )
CALL wrf_dm_bcast_bytes ( time_loop_max , rnum8 )
#endif
! Here we define the initial time to process, for later use by the code.
current_date_char = start_date_char
start_date = start_date_char // '.0000'
current_date = start_date
#ifdef DM_PARALLEL
CALL wrf_dm_bcast_bytes ( start_hour , rnum8 )
#endif
ihour = start_hour
write(message,FMT='(A)') ' READ EMISSIONS 1'
CALL wrf_debug ( 100, message )
! do the ugly stuff
!
if(start_hour.eq.0)CALL construct_filename1 ( bdyname , 'wrfem_00to12z' , grid%id , 2 )
if(start_hour.eq.12)CALL construct_filename1 ( bdyname , 'wrfem_12to24z' , grid%id , 2 )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
open (91,file=bdyname,form='unformatted',status='old')
write(*,*) TRIM( bdyname )
ENDIf
#else
! write(message, FMT='(A,A)') ' OPEN FILE: ',bdyname
! call wrf_message( TRIM( message ) )
open (91,file=bdyname,form='unformatted',status='old')
#endif
! write(message, FMT='(A,A)') ' OPENED FILE: ',bdyname
! call wrf_message( TRIM( message ) )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)nv
read(91)dname
read(91)itime
ENDIF
CALL wrf_dm_bcast_bytes ( nv , rnum8 )
CALL wrf_dm_bcast_bytes ( dname , rnum8 )
CALL wrf_dm_bcast_bytes ( itime , rnum8 )
#else
read(91)nv
read(91)dname
read(91)itime
#endif
write(message, FMT='(A,I10)') ' Number of emissions: ',nv
call wrf_message( TRIM( message ) )
write(message, '(A,I8,A,I8)') ' EMISSIONS INPUT FILE TIME PERIOD (GMT): ',itime-1,' TO ',itime
call wrf_message( TRIM( message ) )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
write(message, FMT='(A)') ' read dumc0 '
call wrf_debug(100, TRIM( message ) )
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
write(message, FMT='(A)') ' write dumc0 to emiss_ant'
call wrf_debug(100, TRIM( message ) )
write(message, FMT='(A,3I10)') ' dims:',ips ,kps,jps
call wrf_message( TRIM( message ) )
write(message, FMT='(A,4I10)') ' dims:',ipe-1,kpe,jpe-1,grid%kemit
call wrf_message( TRIM( message ) )
write(message, FMT='(A,3I10)') ' dims:',ids ,kds,jds
call wrf_message( TRIM( message ) )
write(message, FMT='(A,4I10)') ' dims:',ide-1,kde,jde-1
call wrf_message( TRIM( message ) )
write(message, FMT='(A,5I10)') ' dims:',size(grid%emis_ant,1),size(grid%emis_ant,2),size(grid%emis_ant,3),size(grid%emis_ant,4),p_e_so2
call wrf_message( TRIM( message ) )
write(message, FMT='(A,5I10)') ' dims:',size(dumc0,1),size(dumc0,2),size(dumc0,3)
call wrf_message( TRIM( message ) )
! write(*,*) dumc0(ids:ide-1,1,7)
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_so2)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
! write(*,*) grid%emis_ant(ips:ipe-1,1,7,p_e_so2)
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_no)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
IF (inew_nei .eq. 1) THEN
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_no2)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
ENDIF
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_ald)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_hcho)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_ora2)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_nh3)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_hc3)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_hc5)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_hc8)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_eth)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_co)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_ol2)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_olt)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_oli)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_tol)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_xyl)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_ket)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_csl)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_iso)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
IF( inew_ch4 == 1 ) THEN
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
! grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_ch4)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
ENDIF
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_pm25i)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_pm25j)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_so4i)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_so4j)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_no3i)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_no3j)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
IF (inew_nei .eq. 1) THEN
!! naai and naaj for aqmeii
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_naai)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_naaj)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
ENDIF
!
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_orgi)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_orgj)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_eci)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_ecj)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_pm_10)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
write(message,FMT='(A)') ' PAST READ EMISSIONS 1'
CALL wrf_message ( message )
! grid%input_from_file = .false.
if (config_flags%io_style_emissions.eq.1)then
write(eminame,FMT='(A9,i2.2,a1)') 'wrfchemi_',ihour,'z'
CALL construct_filename1 ( inpname ,TRIM(eminame), grid%id , 2 )
else
CALL construct_filename1( inpname , 'wrfchemi' , grid%id , 2 )
endif
write(message,FMT='(A,A,I10)') ' OPEN FILE ',TRIM(inpname),config_flags%io_form_auxinput5
CALL wrf_debug ( 100, message )
CALL open_w_dataset ( id1, TRIM(inpname) , grid , config_flags , output_auxinput5 , "DATASET=AUXINPUT5", ierr )
write(message,FMT='(A,A)') ' EMISSIONS OUTPUT file name: ',TRIM(inpname)
CALL wrf_message ( message )
IF ( ierr .NE. 0 ) THEN
CALL wrf_error_fatal( 'convert_emiss: error opening wrfchem emissions file for writing' )
ENDIF
CALL calc_current_date ( grid%id , 0. )
CALL geth_newdate ( current_date_char, current_date, 3600 )
current_date = current_date_char // '.0000'
if( stand_lon == 0. ) then
stand_lon = cen_lon
endif
if( moad_cen_lat == 0. ) then
moad_cen_lat = cen_lat
endif
write(message,FMT='(A)') ' WRITE EMISSIONS 1'
CALL wrf_message ( message )
CALL output_auxinput5 ( id1 , grid , config_flags, ierr )
CALL wrf_dm_bcast_bytes ( time_loop , rnum8 )
nemi_frames = time_loop
write(message,FMT='(A,4I10)') 'FRAMES: ',int(nemi_frames),time_loop
CALL wrf_message ( message )
current_date_char = start_date_char
current_date = current_date_char
! if( debug_level >= -100) print *,'NEMI_FRAMES ', nemi_frames,time_loop
! DO emi_frame = 2,1
DO emi_frame = 2,nemi_frames
write(message,FMT='(A,4I10)') 'LOOP: ',emi_frame,nemi_frames
CALL wrf_message ( message )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
write(message,FMT='(A,I4)') 'emi_frame: ',emi_frame
CALL wrf_debug ( 100, message )
CALL domain_clock_get ( grid, current_timestr=timestr )
write(message,FMT='(A,A)') ' Current time ',Trim(timestr)
CALL wrf_debug ( 100, message )
current_date_char = current_date(1:19)
CALL geth_newdate ( next_date_char, current_date_char, int(int_sec) )
current_date = next_date_char // '.0000'
write(message,FMT='(A,A)') ' Date & time ',Trim(current_date)
CALL wrf_message ( message )
CALL domain_clockadvance( grid )
write(message,FMT='(A,I4)') ' Read emissions ',emi_frame
CALL wrf_debug ( 100, message )
write(message,FMT='(A,I4)') ' Hour ',ihour
CALL wrf_message ( message )
ihour = mod(ihour + 1,24)
! Allow writing of both 12h files with 1 submission when io_style_emissions=1 (2 12h files)
if(ihour.eq.0 .or. ihour.eq.12)then
! Read from next binary emissions file
close(91)
if(ihour.eq.0) then
CALL construct_filename1 ( bdyname , 'wrfem_00to12z' , grid%id , 2 )
elseif(ihour.eq.12) then
CALL construct_filename1 ( bdyname , 'wrfem_12to24z' , grid%id , 2 )
endif
open (91,file=bdyname,form='unformatted')
!Write a 2nd netcdf emiss file?
if (config_flags%io_style_emissions .eq.1) then
CALL close_dataset ( id1 , config_flags , "DATASET=AUXOUTPUT5" )
write(eminame,FMT='(A9,i2.2,a1)') 'wrfchemi_',ihour,'z'
CALL construct_filename1 ( inpname ,TRIM(eminame), grid%id , 2 )
write(message,FMT='(A,A,I10)') ' OPEN FILE ',TRIM(inpname),config_flags%io_form_auxinput5
CALL wrf_debug ( 0, message )
CALL open_w_dataset ( id1, TRIM(inpname) , grid , config_flags , output_auxinput5 , "DATASET=AUXINPUT5", ierr )
write(message,FMT='(A,A)') ' EMISSIONS OUTPUT file name: ',TRIM(inpname)
CALL wrf_message ( message )
IF ( ierr .NE. 0 ) THEN
CALL wrf_error_fatal( 'Error opening wrfchem emissions file for writing' )
ENDIF
endif
endif
ENDIF
CALL wrf_dm_bcast_bytes ( ihour , rnum8 )
! CALL wrf_dm_bcast_bytes ( bdyname , rnum8 )
#else
write(message,FMT='(A,I4)') 'emi_frame: ',emi_frame
CALL wrf_debug ( 100, message )
CALL domain_clock_get ( grid, current_timestr=timestr )
write(message,FMT='(A,A)') ' Current time ',Trim(timestr)
CALL wrf_debug ( 100, message )
current_date_char = current_date(1:19)
CALL geth_newdate ( next_date_char, current_date_char, int(int_sec) )
current_date = next_date_char // '.0000'
write(message,FMT='(A,A)') ' Date & time ',Trim(current_date)
CALL wrf_message ( message )
CALL domain_clockadvance( grid )
write(message,FMT='(A,I4)') ' Read emissions ',emi_frame
CALL wrf_debug ( 100, message )
ihour = mod(ihour + 1,24)
if(ihour.eq.0)then
close(91)
CALL construct_filename1 ( bdyname , 'wrfem_00to12z' , grid%id , 2 )
open (91,file=bdyname,form='unformatted')
endif
if(ihour.eq.12) then
close(91)
CALL construct_filename1 ( bdyname , 'wrfem_12to24z' , grid%id , 2 )
open (91,file=bdyname,form='unformatted')
endif
! Allow writing of both 12h files with 1 submission when io_style_emissions=1 (2 12h files)
if(ihour.eq.0 .or. ihour.eq.12)then
! Read from next emissions file
close(91)
if(ihour.eq.0) then
CALL construct_filename1 ( bdyname , 'wrfem_00to12z' , grid%id , 2 )
elseif(ihour.eq.12) then
CALL construct_filename1 ( bdyname , 'wrfem_12to24z' , grid%id , 2 )
endif
open (91,file=bdyname,form='unformatted')
!Write a 2nd netcdf emiss file?
if (config_flags%io_style_emissions .eq.1) then
CALL close_dataset ( id1 , config_flags , "DATASET=AUXOUTPUT5" )
write(message,FMT='(A)') ' CLOSED FIRST FILE, OPENING SECOND FILE'
CALL wrf_message ( message )
write(eminame,FMT='(A9,i2.2,a1)') 'wrfchemi_',ihour,'z'
CALL construct_filename1 ( inpname , TRIM(eminame) , grid%id , 2 )
write(message,FMT='(A,A,I10)') ' OPEN FILE ',TRIM(inpname),config_flags%io_form_auxinput5
CALL wrf_debug ( 0, message )
CALL open_w_dataset ( id1, TRIM(inpname) , grid , config_flags , output_auxinput5 , "DATASET=AUXINPUT5", ierr )
write(message,FMT='(A,A)') ' EMISSIONS OUTPUT file name: ',TRIM(inpname)
CALL wrf_message ( message )
IF ( ierr .NE. 0 ) THEN
CALL wrf_error_fatal( 'Error opening wrfchem emissions file for writing' )
ENDIF
endif
endif
#endif
write(message, '(A,A,I10)') ' USING FILE: ',TRIM(bdyname),ihour
call wrf_message( TRIM( message ) )
if(ihour.eq.0.or.ihour.eq.12)then
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)nv
read(91)dname
ENDIF
CALL wrf_dm_bcast_bytes ( nv , rnum8 )
CALL wrf_dm_bcast_bytes ( dname , rnum8 )
#else
read(91)nv
read(91)dname
#endif
write(message, '(A,I10)') ' Reading FILE header: ',nv
call wrf_message( TRIM( message ) )
endif
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)itime
ENDIF
CALL wrf_dm_bcast_bytes ( itime , rnum8 )
#else
read(91)itime
#endif
write(message, '(A,I10)') ' Reading data from file: ',itime
call wrf_message( TRIM( message ) )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_so2)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
!
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_no)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
IF (inew_nei .eq. 1) THEN
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_no2)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
ENDIF
!
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_ald)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_hcho)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_ora2)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_nh3)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_hc3)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_hc5)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_hc8)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_eth)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_co)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_ol2)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_olt)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_oli)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_tol)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_xyl)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_ket)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_csl)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_iso)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
IF( inew_ch4 == 1 ) THEN
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
! grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_ch4)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
endif
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_pm25i)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_pm25j)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_so4i)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_so4j)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_no3i)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_no3j)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
!
! AQMEII
IF (inew_nei .eq. 1) THEN
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_naai)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
!
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_naaj)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
ENDIF
!
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_orgi)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_orgj)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_eci)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
!
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_ecj)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
!
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc0)
#else
read(91)dumc0(ids:ide-1,kds:grid%kemit,jds:jde-1)
#endif
grid%emis_ant(ips:ipe ,kps:grid%kemit,jps:jpe ,p_e_pm_10)=dumc0(ips:ipe ,kps:grid%kemit,jps:jpe )
write(message,FMT='(A)') ' Past reading emissions '
CALL wrf_debug ( 100, message )
! write global atributes into wrf emissions file
write(message,FMT='(A)') ' Output emissions '
CALL wrf_debug ( 100, message )
CALL output_auxinput5 ( id1 , grid , config_flags , ierr )
! idum1 = 1
END DO ! NEMI_FRAMES loop
!
CLOSE(91)
CALL close_dataset ( id1 , config_flags , "DATASET=AUXOUTPUT5" )
write(message,FMT='(A)') ' DONE WRITING TIME DEPENDENT EMISSIONS FILE'
CALL wrf_message ( message )
endif ! ERADM .or.ERADMSORG .or. ECBMZ
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! NOW DO BIOGENIC EMISSIONS FILE
!
if(CONFIG_FLAGS%BIO_EMISS_OPT == BEIS314 ) then
write(message,FMT='(A)') ' READ BIOGENIC EMISSIONS '
CALL wrf_debug ( 100, message )
!!!!!-------------------------------------------------------------------
! Loop over the file names
DO i=1,numfil
! Remove scratch unzipped file
status=system('rm -f scratem*')
! All reference emissions except NO
IF(i.LE.17)THEN
onefil='BIOREF_'// &
TRIM(ADJUSTL(emfil(i)))//'.gz'
! NO reference emissions
ELSE IF(i.GE.18.AND.i.LE.20)THEN
onefil='AVG_'// &
TRIM(ADJUSTL(emfil(i)))//'.gz'
! LAI
ELSE
onefil='LAI_'// &
TRIM(ADJUSTL(emfil(i)))//'S.gz'
ENDIF
! Copy selected file to scratch
status=system('cp '//TRIM(ADJUSTL(onefil))//' scratem.gz')
! Unzip scratch
status=system('gunzip scratem')
! Open scratch and read into appropriate array
OPEN(26,FILE='scratem',FORM='FORMATTED')
IF(i.EQ. 1) then
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc1)
#else
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
#endif
grid%sebio_iso(ips:ipe ,jps:jpe ) = dumc1(ips:ipe ,jps:jpe )
ENDIF
IF(i.EQ. 2)then
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc1)
#else
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
#endif
grid%sebio_oli(ips:ipe ,jps:jpe ) = dumc1(ips:ipe ,jps:jpe )
ENDIF
IF(i.EQ. 3)then
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc1)
#else
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
#endif
grid%sebio_api(ips:ipe ,jps:jpe ) = dumc1(ips:ipe ,jps:jpe )
ENDIF
IF(i.EQ. 4)then
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc1)
#else
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
#endif
grid%sebio_lim(ips:ipe ,jps:jpe ) = dumc1(ips:ipe ,jps:jpe )
ENDIF
IF(i.EQ. 5)then
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc1)
#else
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
#endif
grid%sebio_xyl(ips:ipe ,jps:jpe ) = dumc1(ips:ipe ,jps:jpe )
ENDIF
IF(i.EQ. 6)then
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc1)
#else
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
#endif
grid%sebio_hc3(ips:ipe ,jps:jpe ) = dumc1(ips:ipe ,jps:jpe )
ENDIF
IF(i.EQ. 7)then
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc1)
#else
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
#endif
grid%sebio_ete(ips:ipe ,jps:jpe ) = dumc1(ips:ipe ,jps:jpe )
ENDIF
IF(i.EQ. 8)then
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc1)
#else
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
#endif
grid%sebio_olt(ips:ipe ,jps:jpe ) = dumc1(ips:ipe ,jps:jpe )
ENDIF
IF(i.EQ. 9)then
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc1)
#else
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
#endif
grid%sebio_ket(ips:ipe ,jps:jpe ) = dumc1(ips:ipe ,jps:jpe )
ENDIF
IF(i.EQ.10)then
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc1)
#else
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
#endif
grid%sebio_ald(ips:ipe ,jps:jpe ) = dumc1(ips:ipe ,jps:jpe )
ENDIF
IF(i.EQ.11)then
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc1)
#else
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
#endif
grid%sebio_hcho(ips:ipe ,jps:jpe ) = dumc1(ips:ipe ,jps:jpe )
ENDIF
IF(i.EQ.12)then
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc1)
#else
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
#endif
grid%sebio_eth(ips:ipe ,jps:jpe ) = dumc1(ips:ipe ,jps:jpe )
ENDIF
IF(i.EQ.13)then
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc1)
#else
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
#endif
grid%sebio_ora2(ips:ipe ,jps:jpe ) = dumc1(ips:ipe ,jps:jpe )
ENDIF
IF(i.EQ.14)then
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc1)
#else
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
#endif
grid%sebio_co(ips:ipe ,jps:jpe ) = dumc1(ips:ipe ,jps:jpe )
ENDIF
IF(i.EQ.15)then
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc1)
#else
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
#endif
grid%sebio_nr(ips:ipe ,jps:jpe ) = dumc1(ips:ipe ,jps:jpe )
ENDIF
! SESQ and MBO are added
IF(i.EQ.16)then
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc1)
#else
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
#endif
grid%sebio_sesq(ips:ipe ,jps:jpe ) = dumc1(ips:ipe ,jps:jpe )
ENDIF
IF(i.EQ.17)then
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc1)
#else
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
#endif
grid%sebio_mbo(ips:ipe ,jps:jpe ) = dumc1(ips:ipe ,jps:jpe )
ENDIF
!
IF(i.EQ.18)then
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc1)
#else
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
#endif
grid%noag_grow(ips:ipe ,jps:jpe ) = dumc1(ips:ipe ,jps:jpe )
ENDIF
IF(i.EQ.19)then
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc1)
#else
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
#endif
grid%noag_nongrow(ips:ipe ,jps:jpe ) = dumc1(ips:ipe ,jps:jpe )
ENDIF
IF(i.EQ.20)then
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc1)
#else
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
#endif
grid%nononag(ips:ipe ,jps:jpe ) = dumc1(ips:ipe ,jps:jpe )
ENDIF
IF(i.EQ.21)then
#ifdef DM_PARALLEL
IF (wrf_dm_on_monitor()) THEN
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
ENDIF
DM_BCAST_MACRO(dumc1)
#else
READ(26,'(12E9.2)') dumc1(ids:ide-1,jds:jde-1)
#endif
grid%slai(ips:ipe ,jps:jpe ) = dumc1(ips:ipe ,jps:jpe )
ENDIF
CLOSE(26)
ENDDO
write(message,FMT='(A)') ' PAST READ BIOGENIC EMISSIONS '
CALL wrf_debug ( 100, message )
write(message,FMT='(A)') ' OPEN BIOGENIC EMISSIONS WRF file'
CALL wrf_debug ( 100, message )
CALL construct_filename1( inpname , 'wrfbiochemi' , grid%id , 2 )
CALL open_w_dataset ( id1, TRIM(inpname) , grid , config_flags , output_auxinput6 , "DATASET=AUXINPUT6", ierr )
write(message,FMT='(A,A)') ' BIOGENIC EMISSIONS file name: ',TRIM(inpname)
CALL wrf_message ( message )
IF ( ierr .NE. 0 ) THEN
CALL wrf_error_fatal( 'convert_emiss: error opening wrfchem emissions file for writing' )
ENDIF
write(message,FMT='(A)') ' WRITE BIOGENIC EMISSIONS WRF file '
CALL wrf_debug ( 100, message )
CALL output_auxinput6 ( id1 , grid , config_flags , ierr )
CALL close_dataset ( id1 , config_flags , "DATASET=AUXOUTPUT6" )
endif ! BIO_EMIS_OPT = BEIS314
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
DEALLOCATE ( dumc0 )
DEALLOCATE ( dumc1 )
CALL med_shutdown_io ( grid , config_flags )
CALL wrf_debug ( 0 , ' EMISSIONS CONVERSION : end of program ')
CALL wrf_shutdown
CALL WRFU_Finalize( rc=rc )
END PROGRAM convert_emissions