SCALE-RM
scale_atmos_sfc_ch_rn222.F90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
10 !-------------------------------------------------------------------------------
11 #include "scalelib.h"
12 module scale_atmos_sfc_ch_rn222
13  !-----------------------------------------------------------------------------
14  !
15  !++ used modules
16  !
17  use scale_precision
18  use scale_io
19  use scale_prof
20  !-----------------------------------------------------------------------------
21  implicit none
22  private
23  !-----------------------------------------------------------------------------
24  !
25  !++ Public procedure
26  !
27  public :: atmos_sfc_ch_rn222_setup
28  public :: atmos_sfc_ch_rn222_finalize
29  public :: atmos_sfc_ch_rn222_ocean_flux
30  public :: atmos_sfc_ch_rn222_land_flux
31 
32  !-----------------------------------------------------------------------------
33  !
34  !++ Public parameters & variables
35  !
36  !-----------------------------------------------------------------------------
37  !
38  !++ Private procedure
39  !
40  !-----------------------------------------------------------------------------
41  !
42  !++ Private parameters & variables
43  !
44  integer, private, parameter :: I_ch_rn222 = 1
45 
46  character(len=H_SHORT), private :: ATMOS_SFC_CH_Rn222_emission_type = 'CONST' ! Emission type
47 
48  ! for constant flux
49  real(RP), private :: ATMOS_SFC_CH_Rn222_const_emission_land = 20.8e-3_rp ! Surface flux from land [Bq/m2/s]
50  real(RP), private :: ATMOS_SFC_CH_Rn222_const_emission_ocean = 0.14e-3_rp ! Surface flux from ocean [Bq/m2/s]
51 
52  ! for flux map by Schery and Wasiolek (1998)
53  character(len=H_LONG), private :: ATMOS_SFC_CH_Rn222_SCHERY1998_dirpath = '.'
54 
55  ! for flux map by Hirao et al. (2010)
56  character(len=H_LONG), private :: ATMOS_SFC_CH_Rn222_HIRAO2010_dirpath = '.'
57  integer, private :: ATMOS_SFC_CH_Rn222_HIRAO2010_ystart = 1979
58  integer, private :: ATMOS_SFC_CH_Rn222_HIRAO2010_yend = 2012
59 
60  integer, private :: ATMOS_SFC_CH_Rn222_nintrp = 5
61 
62  real(RP), private, allocatable :: emission_lat (:,:)
63  real(RP), private, allocatable :: emission_lon (:,:)
64  real(RP), private, allocatable :: emission_value(:,:,:,:)
65 
66  integer, private, allocatable :: idx_i(:,:,:)
67  integer, private, allocatable :: idx_j(:,:,:)
68  real(RP), private, allocatable :: hfact(:,:,:)
69 
70  integer, private :: nlon
71  integer, private :: nlat
72  integer, private :: nmonth
73  integer, private :: nyear
74 
75  !-----------------------------------------------------------------------------
76 contains
77  !-----------------------------------------------------------------------------
79  subroutine atmos_sfc_ch_rn222_setup( &
80  IA, JA, &
81  real_lon, real_lat )
82  use scale_prc, only: &
83  prc_ismaster, &
84  prc_abort
85  use scale_const, only: &
86  const_d2r
87  use scale_comm_cartesc, only: &
88  comm_bcast
89  use scale_interp, only: &
90  interp_factor2d
91  implicit none
92 
93  integer, intent(in) :: ia
94  integer, intent(in) :: ja
95  real(rp), intent(in) :: real_lon(ia,ja) ! longitude [rad]
96  real(rp), intent(in) :: real_lat(ia,ja) ! latitude [rad]
97 
98  namelist / param_atmos_sfc_ch_rn222 / &
99  atmos_sfc_ch_rn222_emission_type, &
100  atmos_sfc_ch_rn222_const_emission_land, &
101  atmos_sfc_ch_rn222_const_emission_ocean, &
102  atmos_sfc_ch_rn222_schery1998_dirpath, &
103  atmos_sfc_ch_rn222_hirao2010_dirpath, &
104  atmos_sfc_ch_rn222_hirao2010_ystart, &
105  atmos_sfc_ch_rn222_hirao2010_yend, &
106  atmos_sfc_ch_rn222_nintrp
107 
108  character(len=H_LONG) :: fname
109  real(rp) :: lon, lat, value
110 
111  integer :: ierr, fid
112  integer :: i, j, m, y, yy
113  !---------------------------------------------------------------------------
114 
115  log_newline
116  log_info("ATMOS_SFC_CH_rn222_setup",*) 'Setup'
117  log_info("ATMOS_SFC_CH_rn222_setup",*) 'rn222 surface flux'
118 
119  !--- read namelist
120  rewind(io_fid_conf)
121  read(io_fid_conf,nml=param_atmos_sfc_ch_rn222,iostat=ierr)
122  if( ierr < 0 ) then !--- missing
123  log_info("ATMOS_SFC_CH_rn222_setup",*) 'Not found namelist. Default used.'
124  elseif( ierr > 0 ) then !--- fatal error
125  log_error("ATMOS_SFC_CH_rn222_setup",*) 'Not appropriate names in namelist PARAM_ATMOS_SFC_CH_RN222. Check!'
126  call prc_abort
127  endif
128  log_nml(param_atmos_sfc_ch_rn222)
129 
130 
131 
132  log_newline
133  log_info("ATMOS_SFC_CH_rn222_setup",*) 'Type of emission of Rn222: ', trim(atmos_sfc_ch_rn222_emission_type)
134 
135  select case( atmos_sfc_ch_rn222_emission_type )
136  case( 'CONST' )
137 
138  log_info_cont('(A,ES16.6)') 'From land [Bq/m2/s] : ', atmos_sfc_ch_rn222_const_emission_land
139  log_info_cont('(A,ES16.6)') 'From ocean [Bq/m2/s] : ', atmos_sfc_ch_rn222_const_emission_ocean
140 
141  case( 'SCHERY1998' )
142 
143  log_info_cont(*) 'Flux map by Schery and Wasiolek (1998) is used'
144 
145  nlon = 360
146  nlat = 180
147  nmonth = 12
148  nyear = 1
149 
150  allocate( emission_lon(nlon,nlat) )
151  allocate( emission_lat(nlon,nlat) )
152  allocate( emission_value(nlon,nlat,nmonth,nyear) )
153 
154  if ( prc_ismaster ) then
155  y = 1
156  do m = 1, nmonth
157  write(fname,'(A,A,I2.2,A)') trim(atmos_sfc_ch_rn222_schery1998_dirpath), "/fdh3a.", m
158  call io_get_fname(fname, fname)
159  log_info_cont(*) 'Read from the ASCII file: ', trim(fname)
160 
161  fid = io_get_available_fid()
162  open( unit = fid, &
163  file = trim(fname), &
164  status = "old", &
165  form = "formatted" )
166 
167  do j = 1, nlat
168  do i = 1, nlon
169  lon = real(i-1,kind=rp) - 180.0_rp ! [180W-179E]
170  lat = 90.0_rp - real(j-1,kind=rp) ! [90N-89S]
171 
172  read(fid,*) value
173 
174  emission_lon(i,j) = ( lon + 0.5_rp ) * const_d2r ! shift +0.5deg, [deg->rad]
175  emission_lat(i,j) = ( lat - 0.5_rp ) * const_d2r ! shift -0.5deg, [deg->rad]
176  emission_value(i,j,m,y) = value * 1.e-3_rp ! [mBq/m2->Bq/m2]
177  enddo
178  enddo
179 
180  close(fid)
181  enddo ! month loop
182  endif
183 
184  case( 'HIRAO2010' )
185 
186  log_info_cont(*) 'Flux map by Hirao et al. (2010) is used'
187  log_info_cont(*) 'Start year: ', atmos_sfc_ch_rn222_hirao2010_ystart
188  log_info_cont(*) 'End year: ', atmos_sfc_ch_rn222_hirao2010_yend
189 
190  if ( atmos_sfc_ch_rn222_hirao2010_ystart < 1979 &
191  .OR. atmos_sfc_ch_rn222_hirao2010_yend > 2012 ) then
192  log_warn('ATMOS_SFC_CH_rn222_setup',*) 'Available period of the data is between 1979 and 2012.'
193  log_warn_cont(*) 'Please check the range of ystart and yend.'
194  atmos_sfc_ch_rn222_hirao2010_ystart = max( atmos_sfc_ch_rn222_hirao2010_ystart, 1979 )
195  atmos_sfc_ch_rn222_hirao2010_yend = min( atmos_sfc_ch_rn222_hirao2010_yend, 2012 )
196  endif
197 
198  nlon = 360
199  nlat = 180
200  nmonth = 12
201  nyear = atmos_sfc_ch_rn222_hirao2010_yend - atmos_sfc_ch_rn222_hirao2010_ystart + 1
202 
203  allocate( emission_lon(nlon,nlat) )
204  allocate( emission_lat(nlon,nlat) )
205  allocate( emission_value(nlon,nlat,nmonth,nyear) )
206 
207  if ( prc_ismaster ) then
208  do y = 1, nyear
209  do m = 1, nmonth
210  yy = y+atmos_sfc_ch_rn222_hirao2010_ystart-1
211  write(fname,'(A,A,I4.4,I2.2)') trim(atmos_sfc_ch_rn222_hirao2010_dirpath), "/flux-hra-revi", yy, m
212  call io_get_fname(fname, fname)
213  log_info_cont(*) 'Read from the ASCII file: ', trim(fname)
214 
215  fid = io_get_available_fid()
216  open( unit = fid, &
217  file = trim(fname), &
218  status = "old", &
219  form = "formatted" )
220 
221  do j = 1, nlat
222  do i = 1, nlon
223  read(fid,*) lon, lat, value
224 
225  emission_lon(i,j) = ( lon + 0.5_rp ) * const_d2r ! shift +0.5deg, [deg->rad]
226  emission_lat(i,j) = ( lat - 0.5_rp ) * const_d2r ! shift -0.5deg, [deg->rad]
227  emission_value(i,j,m,y) = value * 1.e-3_rp ! [mBq/m2->Bq/m2]
228  enddo
229  enddo
230 
231  close(fid)
232  enddo ! month loop
233  enddo ! year loop
234  endif
235 
236  case default
237  log_error("ATMOS_SFC_CH_rn222_setup",*) 'Not supported type of Rn222 emission! Stop.'
238  call prc_abort
239  end select
240 
241  select case( atmos_sfc_ch_rn222_emission_type )
242  case( 'SCHERY1998', 'HIRAO2010' )
243 
244  call comm_bcast( nlon, nlat, emission_lon(:,:) )
245  call comm_bcast( nlon, nlat, emission_lat(:,:) )
246  call comm_bcast( nlon, nlat, nmonth, nyear, emission_value(:,:,:,:) )
247 
248  allocate( idx_i(ia,ja,atmos_sfc_ch_rn222_nintrp) )
249  allocate( idx_j(ia,ja,atmos_sfc_ch_rn222_nintrp) )
250  allocate( hfact(ia,ja,atmos_sfc_ch_rn222_nintrp) )
251 
252  call interp_factor2d( atmos_sfc_ch_rn222_nintrp, & ! [IN]
253  nlon, nlat, & ! [IN]
254  ia, ja, & ! [IN]
255  emission_lon(:,:), & ! [IN]
256  emission_lat(:,:), & ! [IN]
257  real_lon(:,:), & ! [IN]
258  real_lat(:,:), & ! [IN]
259  idx_i(:,:,:), & ! [OUT]
260  idx_j(:,:,:), & ! [OUT]
261  hfact(:,:,:) ) ! [OUT]
262  end select
263 
264  return
265  end subroutine atmos_sfc_ch_rn222_setup
266 
267  !-----------------------------------------------------------------------------
269  subroutine atmos_sfc_ch_rn222_finalize
270 
271  if ( allocated( emission_lon ) ) deallocate( emission_lon )
272  if ( allocated( emission_lat ) ) deallocate( emission_lat )
273  if ( allocated( emission_value ) ) deallocate( emission_value )
274 
275  if ( allocated( idx_i ) ) deallocate( idx_i )
276  if ( allocated( idx_j ) ) deallocate( idx_j )
277  if ( allocated( hfact ) ) deallocate( hfact )
278 
279  return
280  end subroutine atmos_sfc_ch_rn222_finalize
281 
282  !-----------------------------------------------------------------------------
284  subroutine atmos_sfc_ch_rn222_ocean_flux( &
285  IA, IS, IE, &
286  JA, JS, JE, &
287  QA_CH, &
288  SFLX_QTRC )
289  implicit none
290 
291  integer, intent(in) :: ia, is, ie
292  integer, intent(in) :: ja, js, je
293  integer, intent(in) :: qa_ch
294  real(rp), intent(inout) :: sflx_qtrc(ia,ja,qa_ch)
295 
296  integer :: i, j
297  !---------------------------------------------------------------------------
298 
299  select case( atmos_sfc_ch_rn222_emission_type )
300  case( 'CONST', 'SCHERY1998', 'HIRAO2010' )
301 
302  do j = js, je
303  do i = is, ie
304  sflx_qtrc(i,j,i_ch_rn222) = atmos_sfc_ch_rn222_const_emission_ocean
305  enddo
306  enddo
307 
308  end select
309 
310  return
311  end subroutine atmos_sfc_ch_rn222_ocean_flux
312 
313  !-----------------------------------------------------------------------------
315  subroutine atmos_sfc_ch_rn222_land_flux( &
316  IA, IS, IE, &
317  JA, JS, JE, &
318  QA_CH, &
319  NOWDATE, &
320  SFLX_QTRC )
321  use scale_prc, only: &
322  prc_abort
323  use scale_interp, only: &
324  interp_interp2d
325  implicit none
326 
327  integer, intent(in) :: ia, is, ie
328  integer, intent(in) :: ja, js, je
329  integer, intent(in) :: qa_ch
330  integer, intent(in) :: nowdate(6)
331  real(rp), intent(inout) :: sflx_qtrc(ia,ja,qa_ch)
332 
333  integer :: i, j, m, y, yy
334  !---------------------------------------------------------------------------
335 
336  select case( atmos_sfc_ch_rn222_emission_type )
337  case( 'CONST' )
338 
339  do j = js, je
340  do i = is, ie
341  sflx_qtrc(i,j,i_ch_rn222) = atmos_sfc_ch_rn222_const_emission_land
342  enddo
343  enddo
344 
345  case( 'SCHERY1998' )
346 
347  y = 1
348  m = nowdate(2)
349 
350  call interp_interp2d( atmos_sfc_ch_rn222_nintrp, & ! [IN]
351  nlon, nlat, & ! [IN]
352  ia, ja, & ! [IN]
353  idx_i(:,:,:), & ! [IN]
354  idx_j(:,:,:), & ! [IN]
355  hfact(:,:,:), & ! [IN]
356  emission_value(:,:,m,y), & ! [IN]
357  sflx_qtrc(:,:,i_ch_rn222) ) ! [OUT]
358 
359  case( 'HIRAO2010' )
360 
361  yy = nowdate(1)
362  yy = max( yy, 1979 ) ! Use flux of 1979 before 1977
363  yy = min( yy, 2012 ) ! Use flux of 2012 after 2013
364 
365  y = yy-atmos_sfc_ch_rn222_hirao2010_ystart+1
366 
367  if ( y < 1 .OR. y > nyear ) then
368  log_error("ATMOS_SFC_CH_rn222_setup",*) 'emission file does not exist for year=', yy
369  call prc_abort
370  endif
371 
372  m = nowdate(2)
373 
374  call interp_interp2d( atmos_sfc_ch_rn222_nintrp, & ! [IN]
375  nlon, nlat, & ! [IN]
376  ia, ja, & ! [IN]
377  idx_i(:,:,:), & ! [IN]
378  idx_j(:,:,:), & ! [IN]
379  hfact(:,:,:), & ! [IN]
380  emission_value(:,:,m,y), & ! [IN]
381  sflx_qtrc(:,:,i_ch_rn222) ) ! [OUT]
382 
383  end select
384 
385  return
386  end subroutine atmos_sfc_ch_rn222_land_flux
387 
388 end module scale_atmos_sfc_ch_rn222
scale_interp::interp_interp2d
subroutine, public interp_interp2d(npoints, IA_ref, JA_ref, IA, JA, idx_i, idx_j, hfact, val_ref, val, threshold_undef, wsum, val2)
Definition: scale_interp.F90:1376
scale_atmos_sfc_ch_rn222
module atmosphere / surface / chemistry / RN222
Definition: scale_atmos_sfc_ch_rn222.F90:12
scale_atmos_sfc_ch_rn222::atmos_sfc_ch_rn222_setup
subroutine, public atmos_sfc_ch_rn222_setup(IA, JA, real_lon, real_lat)
Setup.
Definition: scale_atmos_sfc_ch_rn222.F90:82
scale_prc::prc_abort
subroutine, public prc_abort
Abort Process.
Definition: scale_prc.F90:350
scale_precision
module PRECISION
Definition: scale_precision.F90:14
scale_interp
module INTERPOLATION
Definition: scale_interp.F90:12
scale_atmos_sfc_ch_rn222::atmos_sfc_ch_rn222_land_flux
subroutine, public atmos_sfc_ch_rn222_land_flux(IA, IS, IE, JA, JS, JE, QA_CH, NOWDATE, SFLX_QTRC)
Emission from the land surface.
Definition: scale_atmos_sfc_ch_rn222.F90:321
scale_io::io_get_available_fid
integer function, public io_get_available_fid()
search & get available file ID
Definition: scale_io.F90:373
scale_prc
module PROCESS
Definition: scale_prc.F90:11
scale_io::io_get_fname
subroutine, public io_get_fname(outstr, instr, rank, ext, len)
generate process specific filename
Definition: scale_io.F90:421
scale_io
module STDIO
Definition: scale_io.F90:10
scale_const
module CONSTANT
Definition: scale_const.F90:11
scale_prof
module profiler
Definition: scale_prof.F90:11
scale_comm_cartesc
module COMMUNICATION
Definition: scale_comm_cartesC.F90:11
scale_atmos_sfc_ch_rn222::atmos_sfc_ch_rn222_finalize
subroutine, public atmos_sfc_ch_rn222_finalize
finalize
Definition: scale_atmos_sfc_ch_rn222.F90:270
scale_const::const_d2r
real(rp), public const_d2r
degree to radian
Definition: scale_const.F90:33
scale_atmos_sfc_ch_rn222::atmos_sfc_ch_rn222_ocean_flux
subroutine, public atmos_sfc_ch_rn222_ocean_flux(IA, IS, IE, JA, JS, JE, QA_CH, SFLX_QTRC)
Emission from the ocean surface.
Definition: scale_atmos_sfc_ch_rn222.F90:289
scale_io::io_fid_conf
integer, public io_fid_conf
Config file ID.
Definition: scale_io.F90:57
scale_prc::prc_ismaster
logical, public prc_ismaster
master process in local communicator?
Definition: scale_prc.F90:92
Generated by   doxygen 1.8.17