SCALE-RM
Functions/Subroutines | Variables
scale_grid_real Module Reference

module GRID (real space) More...

Functions/Subroutines

subroutine, public real_setup
 Setup. More...
 
subroutine, public real_update_z
 Re-setup with updated topography. More...
 
subroutine, public real_calc_areavol (MAPF)
 Calc control area/volume. More...
 

Variables

real(rp), dimension(:,:), allocatable, public real_lon
 longitude [rad,0-2pi] More...
 
real(rp), dimension(:,:), allocatable, public real_lat
 latitude [rad,-pi,pi] More...
 
real(rp), dimension(:,:,:), allocatable, public real_cz
 geopotential height [m] (cell center) More...
 
real(rp), dimension(:,:,:), allocatable, public real_fz
 geopotential height [m] (cell face ) More...
 
real(rp), public real_basepoint_lon
 position of base point in real world [rad,0-2pi] More...
 
real(rp), public real_basepoint_lat
 position of base point in real world [rad,-pi,pi] More...
 
real(rp), dimension(:,:), allocatable, public real_lonx
 longitude at staggered point (uy) [rad,0-2pi] More...
 
real(rp), dimension(:,:), allocatable, public real_lony
 longitude at staggered point (xv) [rad,0-2pi] More...
 
real(rp), dimension(:,:), allocatable, public real_lonxy
 longitude at staggered point (uv) [rad,0-2pi] More...
 
real(rp), dimension(:,:), allocatable, public real_latx
 latitude at staggered point (uy) [rad,-pi,pi] More...
 
real(rp), dimension(:,:), allocatable, public real_laty
 latitude at staggered point (xv) [rad,-pi,pi] More...
 
real(rp), dimension(:,:), allocatable, public real_latxy
 latitude at staggered point (uv) [rad,-pi,pi] More...
 
real(rp), dimension(:,:), allocatable, public real_dlon
 delta longitude More...
 
real(rp), dimension(:,:), allocatable, public real_dlat
 delta latitude More...
 
real(rp), dimension(:,:), allocatable, public real_z1
 Height of the lowermost grid from surface (cell center) [m]. More...
 
real(rp), public real_aspect_max
 maximum aspect ratio of the grid cell More...
 
real(rp), public real_aspect_min
 minimum aspect ratio of the grid cell More...
 
real(rp), dimension(:,:,:), allocatable, public real_phi
 geopotential [m2/s2] (cell center) More...
 
real(rp), dimension(:,:), allocatable, public real_area
 horizontal area [m2] More...
 
real(rp), dimension(:,:,:), allocatable, public real_vol
 control volume [m3] More...
 
real(rp), dimension(:,:,:), allocatable, public real_domain_catalogue
 domain latlon catalogue [rad] More...
 
real(rp), public real_totarea
 total area (local) [m2] More...
 
real(rp), public real_totvol
 total volume (local) [m3] More...
 

Detailed Description

module GRID (real space)

Description
Grid module for orthogonal curvelinear, terrain-following coordinate
Author
Team SCALE
History
  • 2011-10-24 (H.Yashiro) [new] reconstruction from scale_REAL & scale_topography
NAMELIST
  • PARAM_DOMAIN_CATALOGUE
    nametypedefault valuecomment
    DOMAIN_CATALOGUE_FNAME character(len=H_LONG) 'latlon_domain_catalogue.txt' metadata files for lat-lon domain for all processes
    DOMAIN_CATALOGUE_OUTPUT logical .false.

History Output
No history output

Function/Subroutine Documentation

◆ real_setup()

subroutine, public scale_grid_real::real_setup ( )

Setup.

Definition at line 85 of file scale_grid_real.F90.

References scale_fileio::fileio_set_coordinates(), scale_grid::grid_domain_center_x, scale_grid::grid_domain_center_y, scale_grid_index::ia, scale_stdio::io_fid_conf, scale_stdio::io_fid_log, scale_stdio::io_fid_nml, scale_stdio::io_l, scale_stdio::io_nml, scale_grid_index::ja, scale_grid_index::ka, scale_mapproj::mprj_setup(), scale_process::prc_mpistop(), scale_process::prc_nprocs, real_area, real_cz, real_dlat, real_dlon, real_domain_catalogue, real_fz, real_lat, real_latx, real_latxy, real_laty, real_lon, real_lonx, real_lonxy, real_lony, real_phi, real_vol, and real_z1.

Referenced by mod_rm_driver::scalerm(), and mod_rm_prep::scalerm_prep().

85  use scale_process, only: &
86  prc_nprocs, &
88  use scale_grid, only: &
89  grid_domain_center_x, &
90  grid_domain_center_y
91  use scale_mapproj, only: &
93  use scale_fileio, only: &
95  implicit none
96 
97  character(len=H_LONG) :: DOMAIN_CATALOGUE_FNAME = 'latlon_domain_catalogue.txt'
98  logical :: DOMAIN_CATALOGUE_OUTPUT = .false.
99 
100  namelist / param_domain_catalogue / &
101  domain_catalogue_fname, &
102  domain_catalogue_output
103 
104  integer :: ierr
105  !---------------------------------------------------------------------------
106 
107  if( io_l ) write(io_fid_log,*)
108  if( io_l ) write(io_fid_log,*) '++++++ Module[GRID_REAL] / Categ[ATMOS-RM GRID] / Origin[SCALElib]'
109 
110  !--- read namelist
111  rewind(io_fid_conf)
112  read(io_fid_conf,nml=param_domain_catalogue,iostat=ierr)
113  if( ierr < 0 ) then !--- missing
114  if( io_l ) write(io_fid_log,*) '*** Not found namelist. Default used.'
115  elseif( ierr > 0 ) then !--- fatal error
116  write(*,*) 'xxx Not appropriate names in namelist PARAM_DOMAIN_CATALOGUE. Check!'
117  call prc_mpistop
118  endif
119  if( io_nml ) write(io_fid_nml,nml=param_domain_catalogue)
120 
121  allocate( real_lon( ia, ja) )
122  allocate( real_lat( ia, ja) )
123  allocate( real_lonx(0:ia, ja) )
124  allocate( real_lony( ia,0:ja) )
125  allocate( real_lonxy(0:ia,0:ja) )
126  allocate( real_latx(0:ia, ja) )
127  allocate( real_laty( ia,0:ja) )
128  allocate( real_latxy(0:ia,0:ja) )
129  allocate( real_dlon( ia, ja) )
130  allocate( real_dlat( ia, ja) )
131 
132  allocate( real_cz( ka,ia,ja) )
133  allocate( real_fz(0:ka,ia,ja) )
134  allocate( real_z1( ia,ja) )
135  allocate( real_phi( ka,ia,ja) )
136 
137  allocate( real_area( ia,ja) )
138  allocate( real_vol(ka,ia,ja) )
139 
140  allocate( real_domain_catalogue(prc_nprocs,4,2) )
141 
142  ! setup map projection
143  call mprj_setup( grid_domain_center_x, grid_domain_center_y )
144 
145  ! calc longitude & latitude
146  call real_calc_latlon( domain_catalogue_fname, domain_catalogue_output )
147 
148  ! calc real height
149  call real_calc_z
150 
151  ! calc control area & volume
152  ! call REAL_calc_areavol ! must be called after GTRANS_setup
153 
154  ! set latlon and z to fileio module
156  real_lat, real_latx, real_laty, real_latxy, &
157  real_cz, real_fz )
158 
159  return
subroutine, public prc_mpistop
Abort MPI.
real(rp), dimension(:,:,:), allocatable, public real_fz
geopotential height [m] (cell face )
real(rp), dimension(:,:,:), allocatable, public real_cz
geopotential height [m] (cell center)
module FILE I/O (netcdf)
real(rp), dimension(:,:), allocatable, public real_latx
latitude at staggered point (uy) [rad,-pi,pi]
real(rp), dimension(:,:), allocatable, public real_lonxy
longitude at staggered point (uv) [rad,0-2pi]
module PROCESS
module GRID (cartesian)
subroutine, public fileio_set_coordinates(LON, LONX, LONY, LONXY, LAT, LATX, LATY, LATXY, CZ, FZ)
set latlon and z
integer, public io_fid_conf
Config file ID.
Definition: scale_stdio.F90:55
real(rp), dimension(:,:), allocatable, public real_lony
longitude at staggered point (xv) [rad,0-2pi]
subroutine, public mprj_setup(DOMAIN_CENTER_X, DOMAIN_CENTER_Y)
Setup.
integer, public prc_nprocs
myrank in local communicator
real(rp), dimension(:,:), allocatable, public real_latxy
latitude at staggered point (uv) [rad,-pi,pi]
real(rp), dimension(:,:), allocatable, public real_lonx
longitude at staggered point (uy) [rad,0-2pi]
module Map projection
real(rp), dimension(:,:), allocatable, public real_laty
latitude at staggered point (xv) [rad,-pi,pi]
Here is the call graph for this function:
Here is the caller graph for this function:

◆ real_update_z()

subroutine, public scale_grid_real::real_update_z ( )

Re-setup with updated topography.

Definition at line 165 of file scale_grid_real.F90.

References scale_const::const_d2r, scale_const::const_grav, scale_const::const_pi, scale_fileio::fileio_set_coordinates(), scale_grid::grid_cdx, scale_grid::grid_cdy, scale_grid::grid_cx, scale_grid::grid_cy, scale_grid::grid_cz, scale_grid::grid_fx, scale_grid::grid_fy, scale_grid::grid_fz, scale_grid_index::ia, scale_grid_index::ie, scale_stdio::io_fid_log, scale_stdio::io_get_available_fid(), scale_stdio::io_l, scale_grid_index::is, scale_grid_index::ja, scale_grid_index::je, scale_grid_index::js, scale_grid_index::ka, scale_grid_index::ke, scale_grid_index::ks, scale_mapproj::mprj_basepoint_lat, scale_mapproj::mprj_basepoint_lon, scale_mapproj::mprj_xy2lonlat(), scale_process::prc_ismaster, scale_process::prc_mpistop(), scale_process::prc_nprocs, real_aspect_max, real_aspect_min, real_basepoint_lat, real_basepoint_lon, real_cz, real_dlat, real_dlon, real_domain_catalogue, real_fz, real_lat, real_latx, real_latxy, real_laty, real_lon, real_lonx, real_lonxy, real_lony, real_phi, real_z1, and scale_topography::topo_zsfc.

Referenced by mod_rm_prep::scalerm_prep().

165  use scale_process, only: &
167  use scale_fileio, only: &
169  implicit none
170  !---------------------------------------------------------------------------
171 
172  ! calc real height
173  call real_calc_z
174 
175  ! set latlon and z to fileio module
177  real_lat, real_latx, real_laty, real_latxy, &
178  real_cz, real_fz )
179 
180  return
subroutine, public prc_mpistop
Abort MPI.
real(rp), dimension(:,:,:), allocatable, public real_fz
geopotential height [m] (cell face )
real(rp), dimension(:,:,:), allocatable, public real_cz
geopotential height [m] (cell center)
module FILE I/O (netcdf)
real(rp), dimension(:,:), allocatable, public real_latx
latitude at staggered point (uy) [rad,-pi,pi]
real(rp), dimension(:,:), allocatable, public real_lonxy
longitude at staggered point (uv) [rad,0-2pi]
module PROCESS
subroutine, public fileio_set_coordinates(LON, LONX, LONY, LONXY, LAT, LATX, LATY, LATXY, CZ, FZ)
set latlon and z
real(rp), dimension(:,:), allocatable, public real_lony
longitude at staggered point (xv) [rad,0-2pi]
real(rp), dimension(:,:), allocatable, public real_latxy
latitude at staggered point (uv) [rad,-pi,pi]
real(rp), dimension(:,:), allocatable, public real_lonx
longitude at staggered point (uy) [rad,0-2pi]
real(rp), dimension(:,:), allocatable, public real_laty
latitude at staggered point (xv) [rad,-pi,pi]
Here is the call graph for this function:
Here is the caller graph for this function:

◆ real_calc_areavol()

subroutine, public scale_grid_real::real_calc_areavol ( real(rp), dimension(ia,ja,2), intent(in)  MAPF)

Calc control area/volume.

Definition at line 407 of file scale_grid_real.F90.

References scale_const::const_radius, scale_grid::dx, scale_grid::dy, scale_grid::dz, scale_grid_index::ie, scale_grid_index::is, scale_grid_index::je, scale_grid_index::js, scale_grid_index::ke, scale_grid_index::ks, real_area, real_fz, real_totarea, real_totvol, and real_vol.

Referenced by scale_gridtrans::gtrans_setup().

407  use scale_const, only: &
408  radius => const_radius
409  use scale_grid, only: &
410  dz, &
411  dx, &
412  dy
413  implicit none
414  real(RP), intent(in) :: MAPF(IA,JA,2)
415 
416  integer :: k, i, j
417  !---------------------------------------------------------------------------
418 
419  real_totarea = 0.0_rp
420  real_area(:,:) = 0.0_rp
421  do j = js, je
422  do i = is, ie
423  real_area(i,j) = dx * dy / ( mapf(i,j,1) * mapf(i,j,2) )
424  real_totarea = real_totarea + real_area(i,j)
425  enddo
426  enddo
427 
428  real_totvol = 0.0_rp
429  real_vol(:,:,:) = 0.0_rp
430  do j = js, je
431  do i = is, ie
432  do k = ks, ke
433  real_vol(k,i,j) = ( real_fz(k,i,j) - real_fz(k-1,i,j) ) * real_area(i,j)
434  real_totvol = real_totvol + real_vol(k,i,j)
435  enddo
436  enddo
437  enddo
438 
439  return
real(rp), dimension(:,:,:), allocatable, public real_fz
geopotential height [m] (cell face )
module CONSTANT
Definition: scale_const.F90:14
module GRID (cartesian)
Here is the caller graph for this function:

Variable Documentation

◆ real_lon

real(rp), dimension(:,:), allocatable, public scale_grid_real::real_lon

◆ real_lat

real(rp), dimension(:,:), allocatable, public scale_grid_real::real_lat

◆ real_cz

real(rp), dimension (:,:,:), allocatable, public scale_grid_real::real_cz

◆ real_fz

real(rp), dimension (:,:,:), allocatable, public scale_grid_real::real_fz

◆ real_basepoint_lon

real(rp), public scale_grid_real::real_basepoint_lon

position of base point in real world [rad,0-2pi]

Definition at line 43 of file scale_grid_real.F90.

Referenced by scale_atmos_solarins::atmos_solarins_setup(), scale_gridtrans::gtrans_rotcoef(), and real_update_z().

43  real(RP), public :: REAL_BASEPOINT_LON

◆ real_basepoint_lat

real(rp), public scale_grid_real::real_basepoint_lat

position of base point in real world [rad,-pi,pi]

Definition at line 44 of file scale_grid_real.F90.

Referenced by scale_atmos_phy_rd_mstrnx::atmos_phy_rd_mstrnx(), scale_atmos_phy_rd_mstrnx::atmos_phy_rd_mstrnx_setup(), scale_atmos_solarins::atmos_solarins_setup(), scale_gridtrans::gtrans_rotcoef(), and real_update_z().

44  real(RP), public :: REAL_BASEPOINT_LAT

◆ real_lonx

real(rp), dimension (:,:), allocatable, public scale_grid_real::real_lonx

longitude at staggered point (uy) [rad,0-2pi]

Definition at line 46 of file scale_grid_real.F90.

Referenced by mod_cnvlanduse::cnvlanduse(), mod_cnvtopo::cnvtopo(), scale_history::hist_setup(), scale_grid_nest::nest_domain_shape(), scale_grid_nest::nest_setup(), real_setup(), and real_update_z().

46  real(RP), public, allocatable :: REAL_LONX (:,:)

◆ real_lony

real(rp), dimension (:,:), allocatable, public scale_grid_real::real_lony

longitude at staggered point (xv) [rad,0-2pi]

Definition at line 47 of file scale_grid_real.F90.

Referenced by scale_history::hist_setup(), scale_grid_nest::nest_domain_shape(), scale_grid_nest::nest_setup(), real_setup(), and real_update_z().

47  real(RP), public, allocatable :: REAL_LONY (:,:)

◆ real_lonxy

real(rp), dimension(:,:), allocatable, public scale_grid_real::real_lonxy

longitude at staggered point (uv) [rad,0-2pi]

Definition at line 48 of file scale_grid_real.F90.

Referenced by scale_history::hist_setup(), scale_grid_nest::nest_setup(), real_setup(), and real_update_z().

48  real(RP), public, allocatable :: REAL_LONXY(:,:)

◆ real_latx

real(rp), dimension (:,:), allocatable, public scale_grid_real::real_latx

latitude at staggered point (uy) [rad,-pi,pi]

Definition at line 49 of file scale_grid_real.F90.

Referenced by scale_gridtrans::gtrans_setup(), scale_history::hist_setup(), scale_grid_nest::nest_domain_shape(), scale_grid_nest::nest_setup(), real_setup(), and real_update_z().

49  real(RP), public, allocatable :: REAL_LATX (:,:)

◆ real_laty

real(rp), dimension (:,:), allocatable, public scale_grid_real::real_laty

latitude at staggered point (xv) [rad,-pi,pi]

Definition at line 50 of file scale_grid_real.F90.

Referenced by mod_cnvlanduse::cnvlanduse(), mod_cnvtopo::cnvtopo(), scale_gridtrans::gtrans_setup(), scale_history::hist_setup(), scale_grid_nest::nest_domain_shape(), scale_grid_nest::nest_setup(), real_setup(), and real_update_z().

50  real(RP), public, allocatable :: REAL_LATY (:,:)

◆ real_latxy

real(rp), dimension(:,:), allocatable, public scale_grid_real::real_latxy

latitude at staggered point (uv) [rad,-pi,pi]

Definition at line 51 of file scale_grid_real.F90.

Referenced by scale_gridtrans::gtrans_setup(), scale_history::hist_setup(), scale_grid_nest::nest_setup(), real_setup(), and real_update_z().

51  real(RP), public, allocatable :: REAL_LATXY(:,:)

◆ real_dlon

real(rp), dimension (:,:), allocatable, public scale_grid_real::real_dlon

delta longitude

Definition at line 52 of file scale_grid_real.F90.

Referenced by mod_cnvlanduse::cnvlanduse_setup(), mod_cnvtopo::cnvtopo_setup(), real_setup(), and real_update_z().

52  real(RP), public, allocatable :: REAL_DLON (:,:)

◆ real_dlat

real(rp), dimension (:,:), allocatable, public scale_grid_real::real_dlat

delta latitude

Definition at line 53 of file scale_grid_real.F90.

Referenced by mod_cnvlanduse::cnvlanduse_setup(), mod_cnvtopo::cnvtopo_setup(), real_setup(), and real_update_z().

53  real(RP), public, allocatable :: REAL_DLAT (:,:)

◆ real_z1

real(rp), dimension (:,:), allocatable, public scale_grid_real::real_z1

◆ real_aspect_max

real(rp), public scale_grid_real::real_aspect_max

maximum aspect ratio of the grid cell

Definition at line 56 of file scale_grid_real.F90.

Referenced by real_update_z().

56  real(RP), public :: REAL_ASPECT_MAX

◆ real_aspect_min

real(rp), public scale_grid_real::real_aspect_min

minimum aspect ratio of the grid cell

Definition at line 57 of file scale_grid_real.F90.

Referenced by real_update_z().

57  real(RP), public :: REAL_ASPECT_MIN

◆ real_phi

real(rp), dimension (:,:,:), allocatable, public scale_grid_real::real_phi

geopotential [m2/s2] (cell center)

Definition at line 59 of file scale_grid_real.F90.

Referenced by mod_atmos_dyn_driver::atmos_dyn_driver(), scale_atmos_refstate::atmos_refstate_calc3d(), real_setup(), and real_update_z().

59  real(RP), public, allocatable :: REAL_PHI (:,:,:)

◆ real_area

real(rp), dimension(:,:), allocatable, public scale_grid_real::real_area

horizontal area [m2]

Definition at line 61 of file scale_grid_real.F90.

Referenced by real_calc_areavol(), real_setup(), and scale_rm_statistics::stat_total_2d().

61  real(RP), public, allocatable :: REAL_AREA(:,:)

◆ real_vol

real(rp), dimension (:,:,:), allocatable, public scale_grid_real::real_vol

control volume [m3]

Definition at line 62 of file scale_grid_real.F90.

Referenced by scale_atmos_dyn::atmos_dyn(), scale_atmos_dyn_tstep_large_fvm_heve::check_mass(), real_calc_areavol(), real_setup(), and scale_rm_statistics::stat_total_3d().

62  real(RP), public, allocatable :: REAL_VOL (:,:,:)

◆ real_domain_catalogue

real(rp), dimension(:,:,:), allocatable, public scale_grid_real::real_domain_catalogue

domain latlon catalogue [rad]

Definition at line 64 of file scale_grid_real.F90.

Referenced by scale_grid_nest::nest_domain_shape(), real_setup(), and real_update_z().

64  real(RP), public, allocatable :: REAL_DOMAIN_CATALOGUE(:,:,:)

◆ real_totarea

real(rp), public scale_grid_real::real_totarea

total area (local) [m2]

Definition at line 66 of file scale_grid_real.F90.

Referenced by real_calc_areavol().

66  real(RP), public :: REAL_TOTAREA

◆ real_totvol

real(rp), public scale_grid_real::real_totvol

total volume (local) [m3]

Definition at line 67 of file scale_grid_real.F90.

Referenced by real_calc_areavol().

67  real(RP), public :: REAL_TOTVOL