SCALE-RM
mod_cnvuser.F90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
9 !-------------------------------------------------------------------------------
10 #include "scalelib.h"
12  !-----------------------------------------------------------------------------
13  !
14  !++ used modules
15  !
16  use scale_precision
17  use scale_io
18  use scale_prof
20  use scale_tracer
21  !-----------------------------------------------------------------------------
22  implicit none
23  private
24  !-----------------------------------------------------------------------------
25  !
26  !++ Public procedure
27  !
28  public :: cnvuser_setup
29  public :: cnvuser
30 
31  !-----------------------------------------------------------------------------
32  !
33  !++ Public parameters & variables
34  !
35  !-----------------------------------------------------------------------------
36  !
37  !++ Private procedure
38  !
39  private :: cnvuser_write
40 
41  !-----------------------------------------------------------------------------
42  !
43  !++ Private parameters & variables
44  !
45  character(len=H_SHORT), private :: CNVUSER_FILE_TYPE = '' ! '' : do nothing
46  ! 'TILE': tile data
47  ! 'GrADS': GrADS data
48 
49  character(len=H_SHORT), private :: CNVUSER_INTERP_TYPE = 'LINEAR'
50  integer, private :: CNVUSER_INTERP_LEVEL = 5
51 
52  character(len=H_LONG), private :: CNVUSER_OUT_BASENAME = '' ! basename of the output file
53  character(len=H_MID), private :: CNVUSER_OUT_TITLE = 'SCALE-RM User Boundary' ! title of the output file
54  character(len=H_SHORT), private :: CNVUSER_OUT_VARNAME = '' ! name of the variable
55  character(len=H_MID), private :: CNVUSER_OUT_VARDESC = '' ! title of the variable
56  character(len=H_SHORT), private :: CNVUSER_OUT_VARUNIT = '' ! units of the variable
57  character(len=H_SHORT), private :: CNVUSER_OUT_DTYPE = 'DEFAULT' ! REAL4 or REAL8
58  real(DP), private :: CNVUSER_OUT_DT = -1_dp ! sec
59  logical, private :: CNVUSER_OUT_AGGREGATE
60 
61  integer, private :: CNVUSER_NSTEPS = 1 ! # of time steps
62 
63  ! interpolation
64  integer , private :: nLEV, nLON, nLAT
65  integer, private :: itp_lev
66  logical, private :: zonal, pole
67 
68  integer, private, allocatable :: idx_i (:,:,:)
69  integer, private, allocatable :: idx_j (:,:,:)
70  real(RP), private, allocatable :: hfact (:,:,:)
71  integer, private, allocatable :: idx_k (:,:,:,:,:)
72  real(RP), private, allocatable :: vfact (:,:,:,:)
73  real(RP), private, allocatable :: data_org (:,:,:)
74  real(RP), private, allocatable :: X_org (:,:)
75  real(RP), private, allocatable :: Y_org (:,:)
76  real(RP), private, allocatable :: LAT_org (:,:)
77  real(RP), private, allocatable :: LON_org (:,:)
78  real(RP), private, allocatable :: LEV_org (:,:,:)
79  real(RP), private, allocatable :: LAT_1d (:)
80  real(RP), private, allocatable :: LON_1d (:)
81  real(RP), private, allocatable :: LEV_1d (:)
82 
83  ! TILE data
84  character(len=H_SHORT), private :: CNVUSER_TILE_DTYPE = 'real4' ! data type in the tiled data
85  real(RP), private :: CNVUSER_TILE_DLAT
86  real(RP), private :: CNVUSER_TILE_DLON
87  character(len=H_LONG), private :: CNVUSER_TILE_DIR = ''
88  character(len=H_LONG), private :: CNVUSER_TILE_CATALOGUE = ''
89 
90  ! GrADS data
91  character(len=H_LONG), private :: CNVUSER_GrADS_FILENAME = ''
92  character(len=H_SHORT), private :: CNVUSER_GrADS_VARNAME = ''
93  character(len=H_SHORT), private :: CNVUSER_GrADS_LATNAME = 'lat'
94  character(len=H_SHORT), private :: CNVUSER_GrADS_LONNAME = 'lon'
95  character(len=H_SHORT), private :: CNVUSER_GrADS_LEVNAME = ''
96  character(len=H_SHORT), private :: CNVUSER_GrADS_HEIGHT_PLEV = 'HGT'
97 
98  !-----------------------------------------------------------------------------
99 contains
100  !-----------------------------------------------------------------------------
102  subroutine cnvuser_setup
103  use scale_prc, only: &
104  prc_abort
105  use scale_const, only: &
106  pi => const_pi, &
107  d2r => const_d2r
108  use scale_file, only: &
110  use scale_file_grads, only: &
111  file_grads_open, &
112  file_grads_get_shape, &
115  file_grads_read
116  use scale_interp, only: &
122  use scale_mapprojection, only: &
123  mapprojection_lonlat2xy
124  use scale_atmos_grid_cartesc, only: &
125  cx => atmos_grid_cartesc_cx, &
127  use scale_atmos_grid_cartesc_real, only: &
131  use mod_cnv2d, only: &
132  cnv2d_tile_init, &
134  implicit none
135 
136  namelist / param_cnvuser / &
137  cnvuser_file_type, &
138  cnvuser_nsteps, &
139  cnvuser_interp_type, &
140  cnvuser_interp_level, &
141  cnvuser_tile_dtype, &
142  cnvuser_tile_dlat, &
143  cnvuser_tile_dlon, &
144  cnvuser_tile_dir, &
145  cnvuser_tile_catalogue, &
146  cnvuser_grads_filename, &
147  cnvuser_grads_varname, &
148  cnvuser_grads_latname, &
149  cnvuser_grads_lonname, &
150  cnvuser_grads_levname, &
151  cnvuser_grads_height_plev, &
152  cnvuser_out_basename, &
153  cnvuser_out_title, &
154  cnvuser_out_varname, &
155  cnvuser_out_vardesc, &
156  cnvuser_out_varunit, &
157  cnvuser_out_dtype, &
158  cnvuser_out_dt
159 
160  integer :: i, j, k
161  integer :: file_id, var_id
162  integer :: ierr
163  integer :: data_shape(3)
164  !---------------------------------------------------------------------------
165 
166  log_newline
167  log_info("CNVUSER_setup",*) 'Setup'
168 
169  cnvuser_out_aggregate = file_aggregate
170 
171  !--- read namelist
172  rewind(io_fid_conf)
173  read(io_fid_conf,nml=param_cnvuser,iostat=ierr)
174  if( ierr < 0 ) then !--- missing
175  log_info("CNVUSER_setup",*) 'Not found namelist. Default used.'
176  elseif( ierr > 0 ) then !--- fatal error
177  log_error("CNVUSER_setup",*) 'Not appropriate names in namelist PARAM_CNVUSER. Check!'
178  call prc_abort
179  endif
180  log_nml(param_cnvuser)
181 
182  select case ( cnvuser_file_type )
183  case ( '' )
184  ! do nothing
185  case ( 'TILE' )
186  call cnv2d_tile_init( cnvuser_tile_dtype, &
187  cnvuser_tile_dlat, cnvuser_tile_dlon, &
188  cnvuser_tile_dir, &
189  cnvuser_tile_catalogue, &
190  cnvuser_interp_type, &
191  interp_level = cnvuser_interp_level )
192  case ( 'GrADS' )
193  call cnv2d_grads_init( cnvuser_grads_filename, &
194  cnvuser_grads_varname, &
195  cnvuser_grads_latname, &
196  cnvuser_grads_lonname, &
197  cnvuser_interp_type, &
198  interp_level = cnvuser_interp_level )
199  if ( cnvuser_out_varname == '' ) cnvuser_out_varname = cnvuser_grads_varname
200  case ( 'GrADS-3D' )
201  call file_grads_open( cnvuser_grads_filename, & ! [IN]
202  file_id ) ! [OUT]
203 
204  call file_grads_get_shape( file_id, & ! [IN]
205  cnvuser_grads_varname, & ! [IN]
206  data_shape(:) ) ! [OUT]
207  nlev = data_shape(1)
208  nlon = data_shape(2)
209  nlat = data_shape(3)
210 
211  ! interporation
212  select case ( trim(cnvuser_interp_type) )
213  case ( 'LINEAR' )
214  cnvuser_interp_level = 4
215  case ( 'DIST-WEIGHT' )
216  ! do nothing
217  end select
218 
219  allocate( idx_i( ia,ja,cnvuser_interp_level) )
220  allocate( idx_j( ia,ja,cnvuser_interp_level) )
221  allocate( hfact( ia,ja,cnvuser_interp_level) )
222  allocate( idx_k(ka,2,ia,ja,cnvuser_interp_level) )
223  allocate( vfact(ka, ia,ja,cnvuser_interp_level) )
224 
225  allocate( data_org( nlev, nlon, nlat ) )
226  allocate( x_org( nlon, nlat ) )
227  allocate( y_org( nlon, nlat ) )
228  allocate( lat_org( nlon, nlat ) )
229  allocate( lon_org( nlon, nlat ) )
230  allocate( lev_org( nlev, nlon, nlat ) )
231  allocate( lat_1d( nlat ) )
232  allocate( lon_1d( nlon ) )
233  allocate( lev_1d( nlev ) )
234 
235  ! lat
236  call file_grads_varid( file_id, & ! [IN]
237  cnvuser_grads_latname, & ! [IN]
238  var_id ) ! [OUT]
239 
240  if ( file_grads_isoned( file_id, var_id ) ) then
241  call file_grads_read( file_id, & ! [IN]
242  var_id, & ! [IN]
243  lat_1d(:) ) ! [OUT]
244 
245  !$omp parallel do collapse(2)
246  do j = 1, nlat
247  do i = 1, nlon
248  lat_org(i,j) = lat_1d(j) * d2r
249  end do
250  end do
251  else
252  call file_grads_read( file_id, & ! [IN]
253  var_id, & ! [IN]
254  lat_org(:,:) ) ! [OUT]
255 
256  !$omp parallel do collapse(2)
257  do j = 1, nlat
258  do i = 1, nlon
259  lat_org(i,j) = lat_org(i,j) * d2r
260  end do
261  end do
262  end if
263 
264  ! lon
265  call file_grads_varid( file_id, & ! [IN]
266  cnvuser_grads_lonname, & ! [IN]
267  var_id ) ! [OUT]
268 
269  if ( file_grads_isoned( file_id, var_id ) ) then
270  call file_grads_read( file_id, & ! [IN]
271  var_id, & ! [IN]
272  lon_1d(:) ) ! [OUT]
273 
274  !$omp parallel do collapse(2)
275  do j = 1, nlat
276  do i = 1, nlon
277  lon_org(i,j) = lon_1d(i) * d2r
278  end do
279  end do
280  else
281  call file_grads_read( file_id, & ! [IN]
282  var_id, & ! [IN]
283  lon_org(:,:) ) ! [OUT]
284 
285  !$omp parallel do collapse(2)
286  do j = 1, nlat
287  do i = 1, nlon
288  lon_org(i,j) = lon_org(i,j) * d2r
289  end do
290  end do
291  end if
292 
293  ! lev
294  select case ( trim(cnvuser_grads_levname) )
295  case ( 'zlev' )
296  call file_grads_varid( file_id, & ! [IN]
297  cnvuser_grads_levname, & ! [IN]
298  var_id ) ! [OUT]
299 
300  call file_grads_read( file_id, & ! [IN]
301  var_id, & ! [IN]
302  lev_1d(:) ) ! [OUT]
303 
304  !$omp parallel do collapse(3)
305  do j = 1, nlat
306  do i = 1, nlon
307  do k = 1, nlev
308  lev_org(k,i,j) = lev_1d(k)
309  end do
310  end do
311  end do
312  case ( 'plev' )
313  call file_grads_varid( file_id, & ! [IN]
314  cnvuser_grads_height_plev, & ! [IN]
315  var_id ) ! [OUT]
316 
317  call file_grads_read( file_id, & ! [IN]
318  var_id, & ! [IN]
319  lev_org(:,:,:) ) ! [OUT]
320  case default
321  log_error("CNVUSER_setup",*) 'Invalid proparty in CNVUSER_GrADS_LEVNAME: ', trim(cnvuser_grads_levname)
322  call prc_abort
323  end select
324 
325  ! prepare to read target data
326  call file_grads_varid( file_id, & ! [IN]
327  cnvuser_grads_varname, & ! [IN]
328  var_id ) ! [OUT]
329 
330  select case ( cnvuser_interp_type )
331  case ( 'LINEAR' )
332  call mapprojection_lonlat2xy( nlon, 1, nlon, & ! [IN]
333  nlat, 1, nlat, & ! [IN]
334  lon_org(:,:), & ! [IN]
335  lat_org(:,:), & ! [IN]
336  x_org(:,:), & ! [OUT]
337  y_org(:,:) ) ! [OUT]
338 
339  zonal = ( maxval(lon_org(:,:)) - minval(lat_org(:,:)) ) > 2.0_rp * pi * 0.9_rp
340  pole = ( maxval(lat_org(:,:)) > pi * 0.5_rp * 0.9_rp ) .or. ( minval(lat_org(:,:)) < - pi * 0.5_rp * 0.9_rp )
341 
342  call interp_factor3d_linear_xy( nlev, 1, nlev, & ! [IN]
343  nlon, nlat, & ! [IN]
344  ka, 1, ka, & ! [IN]
345  ia, ja, & ! [IN]
346  x_org(:,:), & ! [IN]
347  y_org(:,:), & ! [IN]
348  lev_org(:,:,:), & ! [IN]
349  cx(:), & ! [IN]
350  cy(:), & ! [IN]
351  cz(:,:,:), & ! [IN]
352  idx_i(:,:,:), & ! [OUT]
353  idx_j(:,:,:), & ! [OUT]
354  hfact(:,:,:), & ! [OUT]
355  idx_k(:,:,:,:,:), & ! [OUT]
356  vfact(:,:,:,:), & ! [OUT]
357  zonal = zonal, & ! [IN]
358  pole = pole ) ! [IN]
359  case ( 'DIST-WEIGHT' )
360  call interp_factor3d_weight( cnvuser_interp_level, & ! [IN]
361  nlev, 1, nlev, & ! [IN]
362  nlon, nlat, & ! [IN]
363  ka, 1, ka, & ! [IN]
364  ia, ja, & ! [IN]
365  lon_org(:,:), & ! [IN]
366  lat_org(:,:), & ! [IN]
367  lev_org(:,:,:), & ! [IN]
368  lon(:,:), & ! [IN]
369  lat(:,:), & ! [IN]
370  cz(:,:,:), & ! [IN]
371  idx_i(:,:,:), & ! [OUT]
372  idx_j(:,:,:), & ! [OUT]
373  hfact(:,:,:), & ! [OUT]
374  idx_k(:,:,:,:,:), & ! [OUT]
375  vfact(:,:,:,:) ) ! [OUT]
376  end select
377 
378  if ( cnvuser_out_varname == '' ) cnvuser_out_varname = cnvuser_grads_varname
379  case default
380  log_error('CNVUSER_setup',*) 'CNVUSER_FILE_TYPE is invalid: ', trim(cnvuser_file_type)
381  log_error_cont(*) 'It must be "TILE" or "GrADS".'
382  call prc_abort
383  end select
384 
385  if ( cnvuser_file_type .ne. '' ) then
386  if ( cnvuser_out_basename == '' .or. cnvuser_out_varname == '' ) then
387  log_error('CNVUSER_setup',*) 'CNVUSER_OUT_BASENAME and CNVUSER_OUT_VARNAME are required'
388  call prc_abort
389  end if
390  end if
391 
392  return
393  end subroutine cnvuser_setup
394 
395  !-----------------------------------------------------------------------------
397  subroutine cnvuser
398  use scale_file_cartesc, only: &
401  file_cartesc_write_var, &
404  use scale_time, only: &
406  use scale_interp, only: &
408  use scale_file_grads, only: &
409  file_grads_open, &
411  file_grads_read
412  use scale_atmos_grid_cartesc_real, only: &
414  use mod_cnv2d, only: &
415  cnv2d_exec
416  implicit none
417 
418  real(rp) :: var(ia,ja)
419  real(rp) :: var_3d(ka,ia,ja,1)
420 
421  real(dp) :: timeofs
422 
423  integer :: fid, vid
424  integer :: file_id, var_id
425  integer :: step
426  !---------------------------------------------------------------------------
427 
428  select case ( cnvuser_file_type )
429  case ( 'TILE', 'GrADS' )
430 
431  call file_cartesc_create( cnvuser_out_basename, & ! [IN]
432  cnvuser_out_title, & ! [IN]
433  cnvuser_out_dtype, & ! [IN]
434  fid, & ! [OUT]
435  date = time_nowdate, & ! [IN]
436  haszcoord = .false., & ! [IN]
437  aggregate = cnvuser_out_aggregate ) ! [IN]
438 
439  call file_cartesc_def_var( fid, & ! [IN]
440  cnvuser_out_varname, & ! [IN]
441  cnvuser_out_vardesc, & ! [IN]
442  cnvuser_out_varunit, & ! [IN]
443  'XYT', & ! [IN]
444  cnvuser_out_dtype, & ! [IN]
445  vid, & ! [OUT]
446  timeintv = cnvuser_out_dt, & ! [IN]
447  nsteps = cnvuser_nsteps ) ! [IN]
448 
449  call file_cartesc_enddef(fid)
450 
451  do step = 1, cnvuser_nsteps
452  log_progress(*) 'step = ', step
453 
454  call cnv2d_exec( var(:,:), step = step )
455 
456  call cnvuser_write( fid, vid, var(:,:), cnvuser_out_dt, step )
457 
458  end do
459 
460  call file_cartesc_close( fid )
461 
462  case ( 'GrADS-3D' )
463 
464  call file_cartesc_create( cnvuser_out_basename, & ! [IN]
465  cnvuser_out_title, & ! [IN]
466  cnvuser_out_dtype, & ! [IN]
467  fid, & ! [OUT]
468  date = time_nowdate, & ! [IN]
469  haszcoord = .true., & ! [IN]
470  aggregate = cnvuser_out_aggregate ) ! [IN]
471 
472  call file_cartesc_def_var( fid, & ! [IN]
473  cnvuser_out_varname, & ! [IN]
474  cnvuser_out_vardesc, & ! [IN]
475  cnvuser_out_varunit, & ! [IN]
476  'ZXYT', & ! [IN]
477  cnvuser_out_dtype, & ! [IN]
478  vid, & ! [OUT]
479  timeintv = cnvuser_out_dt, & ! [IN]
480  nsteps = cnvuser_nsteps ) ! [IN]
481 
482  call file_cartesc_enddef(fid)
483 
484  call file_grads_open( cnvuser_grads_filename, & ! [IN]
485  file_id ) ! [OUT]
486 
487  call file_grads_varid( file_id, & ! [IN]
488  cnvuser_grads_varname, & ! [IN]
489  var_id ) ! [OUT]
490 
491  do step = 1, cnvuser_nsteps
492  log_progress(*) 'step = ', step
493  timeofs = ( step - 1 ) * cnvuser_out_dt
494 
495  call file_grads_read( file_id, var_id, & ! [IN]
496  data_org(:,:,:), & ! [OUT]
497  step = step ) ! [IN]
498 
499  call interp_interp3d( cnvuser_interp_level, & ! [IN]
500  nlev, 1, nlev, & ! [IN]
501  nlon, nlat, & ! [IN]
502  ka, 1, ka, & ! [IN]
503  ia, ja, & ! [IN]
504  idx_i(:,:,:), & ! [IN]
505  idx_j(:,:,:), & ! [IN]
506  hfact(:,:,:), & ! [IN]
507  idx_k(:,:,:,:,:), & ! [IN]
508  vfact(:,:,:,:), & ! [IN]
509  lev_org(:,:,:), & ! [IN]
510  cz(:,:,:), & ! [IN]
511  data_org(:,:,:), & ! [IN]
512  var_3d(:,:,:,1) ) ! [OUT]
513 
514  call file_cartesc_write_var( fid, vid, & ! [IN]
515  var_3d(:,:,:,:), & ! [IN]
516  cnvuser_out_varname, & ! [IN]
517  'ZXYT', & ! [IN]
518  cnvuser_out_dt, & ! [IN]
519  timetarg = 1, & ! [IN]
520  timeofs = timeofs ) ! [IN]
521  end do
522 
523  call file_cartesc_close( fid )
524 
525  end select
526 
527  return
528  end subroutine cnvuser
529 
530  ! private
531 
532  subroutine cnvuser_write( &
533  fid, vid, &
534  VAR, &
535  timeintv, &
536  istep )
537  use scale_file_cartesc, only: &
538  file_cartesc_write_var
539  implicit none
540 
541  integer, intent(in) :: fid, vid
542  real(rp), intent(in) :: var(ia,ja,1)
543  real(dp), intent(in) :: timeintv
544  integer, intent(in) :: istep
545 
546  real(dp) :: timeofs
547  !---------------------------------------------------------------------------
548 
549  timeofs = ( istep - 1 ) * timeintv
550  call file_cartesc_write_var( fid, vid, & ! [IN]
551  var(:,:,:), & ! [IN]
552  cnvuser_out_varname, & ! [IN]
553  'XYT', & ! [IN]
554  timeintv, & ! [IN]
555  timetarg = 1, & ! [IN]
556  timeofs = timeofs ) ! [IN]
557 
558  return
559  end subroutine cnvuser_write
560 
561 end module mod_cnvuser
mod_cnv2d::cnv2d_grads_init
subroutine, public cnv2d_grads_init(FILE_NAME, VAR_NAME, LAT_NAME, LON_NAME, interp_type, interp_level, search_limit, POSTFIX)
Definition: mod_cnv2d.F90:227
mod_cnv2d
module Convert 2D data
Definition: mod_cnv2d.F90:11
scale_prc::prc_abort
subroutine, public prc_abort
Abort Process.
Definition: scale_prc.F90:342
scale_file_grads::file_grads_isoned
logical function, public file_grads_isoned(file_id, var_id)
Definition: scale_file_grads.F90:332
scale_file_grads::file_grads_open
subroutine, public file_grads_open(file_name, file_id)
Open.
Definition: scale_file_grads.F90:102
scale_atmos_grid_cartesc_real::atmos_grid_cartesc_real_cz
real(rp), dimension(:,:,:), allocatable, public atmos_grid_cartesc_real_cz
geopotential height [m] (zxy)
Definition: scale_atmos_grid_cartesC_real.F90:38
scale_file_cartesc::file_cartesc_enddef
subroutine, public file_cartesc_enddef(fid)
Exit netCDF file define mode.
Definition: scale_file_cartesC.F90:943
scale_file_cartesc::file_cartesc_def_var
subroutine, public file_cartesc_def_var(fid, varname, desc, unit, dim_type, datatype, vid, standard_name, timeintv, nsteps, cell_measures)
Define a variable to file.
Definition: scale_file_cartesC.F90:3307
scale_interp::interp_factor2d_weight
subroutine, public interp_factor2d_weight(npoints, IA_ref, JA_ref, IA, JA, lon_ref, lat_ref, lon, lat, idx_i, idx_j, hfact, search_limit, latlon_structure, lon_1d, lat_1d, weight_order)
Definition: scale_interp.F90:677
scale_precision
module PRECISION
Definition: scale_precision.F90:14
scale_atmos_grid_cartesc_index::ka
integer, public ka
Definition: scale_atmos_grid_cartesC_index.F90:47
scale_interp
module INTERPOLATION
Definition: scale_interp.F90:12
scale_file_grads::file_grads_varid
subroutine, public file_grads_varid(file_id, var_name, var_id)
Definition: scale_file_grads.F90:300
scale_atmos_grid_cartesc_real
module Atmosphere GRID CartesC Real(real space)
Definition: scale_atmos_grid_cartesC_real.F90:11
scale_atmos_grid_cartesc_real::atmos_grid_cartesc_real_lon
real(rp), dimension(:,:), allocatable, public atmos_grid_cartesc_real_lon
longitude [rad,0-2pi]
Definition: scale_atmos_grid_cartesC_real.F90:48
scale_file
module file
Definition: scale_file.F90:15
mod_cnvuser::cnvuser_setup
subroutine, public cnvuser_setup
Setup.
Definition: mod_cnvuser.F90:103
scale_prc
module PROCESS
Definition: scale_prc.F90:11
scale_const::const_pi
real(rp), public const_pi
pi
Definition: scale_const.F90:31
scale_mapprojection
module Map projection
Definition: scale_mapprojection.F90:12
scale_io
module STDIO
Definition: scale_io.F90:10
mod_cnvuser
module Convert 2D user data
Definition: mod_cnvuser.F90:11
mod_cnvuser::cnvuser
subroutine, public cnvuser
Driver.
Definition: mod_cnvuser.F90:398
scale_tracer::k
real(rp), public k
Definition: scale_tracer.F90:44
scale_atmos_grid_cartesc_index
module atmosphere / grid / cartesC index
Definition: scale_atmos_grid_cartesC_index.F90:12
scale_const
module CONSTANT
Definition: scale_const.F90:11
scale_atmos_grid_cartesc_index::ia
integer, public ia
Definition: scale_atmos_grid_cartesC_index.F90:48
scale_file_cartesc::file_cartesc_close
subroutine, public file_cartesc_close(fid)
Close a netCDF file.
Definition: scale_file_cartesC.F90:1023
scale_prof
module profiler
Definition: scale_prof.F90:11
scale_file_grads
module file_grads
Definition: scale_file_grads.F90:11
scale_atmos_grid_cartesc_index::ja
integer, public ja
Definition: scale_atmos_grid_cartesC_index.F90:49
scale_time
module TIME
Definition: scale_time.F90:11
scale_interp::interp_factor3d_linear_xy
subroutine, public interp_factor3d_linear_xy(KA_ref, KS_ref, KE_ref, IA_ref, JA_ref, KA, KS, KE, IA, JA, x_ref, y_ref, hgt_ref, x, y, hgt, idx_i, idx_j, hfact, idx_k, vfact, flag_extrap, zonal, pole)
Definition: scale_interp.F90:945
mod_cnv2d::cnv2d_exec
subroutine, public cnv2d_exec(var, step, min_value, yrevers)
Definition: mod_cnv2d.F90:330
scale_interp::interp_interp3d
subroutine, public interp_interp3d(npoints, KA_ref, KS_ref, KE_ref, IA_ref, JA_ref, KA, KS, KE, IA, JA, idx_i, idx_j, hfact, idx_k, vfact, hgt_ref, hgt, val_ref, val, spline, logwgt, threshold_undef, wsum, val2)
Definition: scale_interp.F90:1322
scale_tracer
module TRACER
Definition: scale_tracer.F90:12
scale_file::file_aggregate
logical, public file_aggregate
Definition: scale_file.F90:182
scale_file_cartesc::file_cartesc_create
subroutine, public file_cartesc_create(basename, title, datatype, fid, date, subsec, haszcoord, append, aggregate, single)
Create/open a netCDF file.
Definition: scale_file_cartesC.F90:780
mod_cnv2d::cnv2d_tile_init
subroutine, public cnv2d_tile_init(dtype, dlat, dlon, dir, catalogue, interp_type, interp_level, nmax)
Definition: mod_cnv2d.F90:126
scale_time::time_nowdate
integer, dimension(6), public time_nowdate
current time [YYYY MM DD HH MM SS]
Definition: scale_time.F90:66
scale_atmos_grid_cartesc::atmos_grid_cartesc_cy
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_cy
center coordinate [m]: y, local
Definition: scale_atmos_grid_cartesC.F90:56
scale_interp::interp_factor2d_linear_latlon
subroutine, public interp_factor2d_linear_latlon(IA_ref, JA_ref, IA, JA, lon_ref, lat_ref, lon, lat, idx_i, idx_j, hfact)
Definition: scale_interp.F90:341
scale_interp::interp_factor2d_linear_xy
subroutine, public interp_factor2d_linear_xy(IA_ref, JA_ref, IA, JA, x_ref, y_ref, x, y, idx_i, idx_j, hfact, zonal, pole)
Definition: scale_interp.F90:450
scale_interp::interp_factor3d_weight
subroutine, public interp_factor3d_weight(npoints, KA_ref, KS_ref, KE_ref, IA_ref, JA_ref, KA, KS, KE, IA, JA, lon_ref, lat_ref, hgt_ref, lon, lat, hgt, idx_i, idx_j, hfact, idx_k, vfact, flag_extrap)
Definition: scale_interp.F90:1022
scale_const::const_d2r
real(rp), public const_d2r
degree to radian
Definition: scale_const.F90:32
scale_atmos_grid_cartesc_real::atmos_grid_cartesc_real_lat
real(rp), dimension(:,:), allocatable, public atmos_grid_cartesc_real_lat
latitude [rad,-pi,pi]
Definition: scale_atmos_grid_cartesC_real.F90:52
scale_atmos_grid_cartesc
module atmosphere / grid / cartesC
Definition: scale_atmos_grid_cartesC.F90:12
scale_io::io_fid_conf
integer, public io_fid_conf
Config file ID.
Definition: scale_io.F90:56
scale_file_cartesc
module file / cartesianC
Definition: scale_file_cartesC.F90:11
scale_atmos_grid_cartesc::atmos_grid_cartesc_cx
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_cx
center coordinate [m]: x, local
Definition: scale_atmos_grid_cartesC.F90:55