|
| 1 | +!*********************************************************************** |
| 2 | +!* Apache License 2.0 |
| 3 | +!* |
| 4 | +!* This file is part of the GFDL Flexible Modeling System (FMS). |
| 5 | +!* |
| 6 | +!* Licensed under the Apache License, Version 2.0 (the "License"); |
| 7 | +!* you may not use this file except in compliance with the License. |
| 8 | +!* You may obtain a copy of the License at |
| 9 | +!* |
| 10 | +!* http://www.apache.org/licenses/LICENSE-2.0 |
| 11 | +!* |
| 12 | +!* FMS is distributed in the hope that it will be useful, but WITHOUT |
| 13 | +!* WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied; |
| 14 | +!* without even the implied warranty of MERCHANTABILITY or FITNESS FOR A |
| 15 | +!* PARTICULAR PURPOSE. See the License for the specific language |
| 16 | +!* governing permissions and limitations under the License. |
| 17 | +!*********************************************************************** |
| 18 | + |
| 19 | +!> @brief This programs tests diag_manager with the following diag_table |
| 20 | + |
| 21 | +program test_modern_diag |
| 22 | +use mpp_domains_mod, only: domain2d, mpp_domains_set_stack_size, mpp_define_domains, mpp_define_io_domain, & |
| 23 | + mpp_define_mosaic, domainug, mpp_get_compute_domains, mpp_define_unstruct_domain, & |
| 24 | + mpp_get_compute_domain, mpp_get_data_domain, mpp_get_UG_domain_grid_index, & |
| 25 | + mpp_get_UG_compute_domain |
| 26 | +use diag_manager_mod, only: diag_manager_init, diag_manager_end, diag_axis_init, register_diag_field, & |
| 27 | + diag_axis_add_attribute, diag_field_add_attribute, diag_send_complete, & |
| 28 | + diag_manager_set_time_end, send_data, register_static_field, & |
| 29 | + diag_field_add_cell_measures |
| 30 | +use platform_mod, only: r8_kind, r4_kind |
| 31 | +use fms_mod, only: fms_init, fms_end |
| 32 | +use mpp_mod, only: FATAL, mpp_error, mpp_npes, mpp_pe, mpp_root_pe, mpp_broadcast, input_nml_file |
| 33 | +use time_manager_mod, only: time_type, set_calendar_type, set_date, JULIAN, set_time, OPERATOR(+) |
| 34 | +use fms_diag_object_mod,only: dump_diag_obj |
| 35 | + |
| 36 | +implicit none |
| 37 | + |
| 38 | +type(time_type) :: Time !< Time of the simulation |
| 39 | +type(time_type) :: Time_step !< Time_step of the simulation |
| 40 | +integer, dimension(2) :: layout !< Layout to use when setting up the domain |
| 41 | +integer, dimension(2) :: io_layout !< io layout to use when setting up the io domain |
| 42 | +integer :: nx !< Number of x points |
| 43 | +integer :: ny !< Number of y points |
| 44 | +integer :: nz !< Number of z points |
| 45 | +integer :: ug_dim_size !< Number of points in the UG |
| 46 | +type(domain2d) :: Domain !< 2D domain |
| 47 | +type(domain2d) :: Domain_cube_sph !< cube sphere domain |
| 48 | +type(domainug) :: land_domain !< Unstructured domain |
| 49 | +real, dimension(:), allocatable:: x !< X axis data |
| 50 | +real, dimension(:), allocatable:: y !< Y axis_data |
| 51 | +real, dimension(:), allocatable:: z !< Z axis_data |
| 52 | +integer, dimension(:), allocatable:: ug_dim_data !< UG axis_data |
| 53 | +integer :: i !< For do loops |
| 54 | +integer :: id_x !< axis id for the x dimension |
| 55 | +integer :: id_y !< axis id for the y dimension |
| 56 | +integer :: id_UG !< axis id for the unstructured dimension |
| 57 | +integer :: id_z !< axis id for the z dimention |
| 58 | +integer :: id_lon |
| 59 | +integer :: id_lat |
| 60 | + |
| 61 | +integer :: id_var |
| 62 | +real, dimension(:,:), allocatable :: var_data !< Dummy variable data to send to diag_manager |
| 63 | +logical :: used !< Used for send_data call |
| 64 | + |
| 65 | +call fms_init |
| 66 | +call set_calendar_type(JULIAN) |
| 67 | +call diag_manager_init |
| 68 | + |
| 69 | +nx = 96 |
| 70 | +ny = 96 |
| 71 | +nz = 5 |
| 72 | +layout = (/1, mpp_npes()/) |
| 73 | +io_layout = (/1, 1/) |
| 74 | + |
| 75 | +!> Set up a normal (lat/lon) 2D domain, a cube sphere, and UG domain |
| 76 | +call set_up_2D_domain(domain, layout, nx, ny, io_layout) |
| 77 | +call set_up_cube_sph_domain(Domain_cube_sph, nx, ny, io_layout) |
| 78 | +call create_land_domain(Domain_cube_sph, nx, ny, 6, land_domain, npes_group=1) |
| 79 | +call mpp_get_UG_compute_domain(land_domain, size=ug_dim_size) |
| 80 | + |
| 81 | +allocate(ug_dim_data(ug_dim_size)) |
| 82 | +call mpp_get_UG_domain_grid_index(land_domain, ug_dim_data) |
| 83 | +ug_dim_data = ug_dim_data - 1 |
| 84 | + |
| 85 | +! Set up the data |
| 86 | +allocate(x(ug_dim_size), y(ug_dim_size), z(nz)) |
| 87 | +do i=1,ug_dim_size |
| 88 | + x(i) = i |
| 89 | +enddo |
| 90 | +do i=1,ug_dim_size |
| 91 | + y(i) = i |
| 92 | +enddo |
| 93 | +do i=1,nz |
| 94 | + z(i) = i |
| 95 | +enddo |
| 96 | + |
| 97 | +! Set up the initial time |
| 98 | +Time = set_date(2,1,1,0,0,0) |
| 99 | + |
| 100 | +! Register the diags axis |
| 101 | +id_x = diag_axis_init('grid_xt', x, 'point_E', 'x', long_name='point_E', set_name="land") |
| 102 | +id_y = diag_axis_init('grid_yt', y, 'point_N', 'y', long_name='point_N', set_name="land") |
| 103 | +id_z = diag_axis_init('z', z, 'point_Z', 'z', long_name='point_Z') |
| 104 | + |
| 105 | +id_ug = diag_axis_init("grid_index", real(ug_dim_data), "none", "U", long_name="grid indices", & |
| 106 | + DomainU=land_domain, aux="geolon_t geolat_t", set_name="land") |
| 107 | + |
| 108 | +call diag_axis_add_attribute (id_ug, 'compress', 'grid_xt grid_yt') |
| 109 | + |
| 110 | +! Register the variables |
| 111 | +id_lon = register_diag_field ('lnd_mod', 'grid_xt', (/id_x/), Time, 'lon', 'mullions') |
| 112 | +id_lat = register_diag_field ('lnd_mod', 'grid_yt', (/id_y/), Time, 'lat', 'mullions') |
| 113 | + |
| 114 | + |
| 115 | +id_var = register_diag_field ('lnd_mod', 'var1', (/id_ug, id_z /), Time, 'Some scalar var', 'mullions', & |
| 116 | + standard_name="Land is important!") |
| 117 | + |
| 118 | +call diag_manager_set_time_end(Time) |
| 119 | +call diag_manager_set_time_end(set_date(2,1,2,0,0,0)) |
| 120 | + |
| 121 | +allocate(var_data(ug_dim_size, nz)) |
| 122 | + |
| 123 | +Time_step = set_time (3600,0) !< 1 hour |
| 124 | + |
| 125 | +used = send_data(id_lon, x, Time) |
| 126 | +used = send_data(id_lat, y, Time) |
| 127 | + |
| 128 | +do i=1,23 |
| 129 | + Time = Time + Time_step |
| 130 | + var_data = real(i) |
| 131 | + |
| 132 | + used = send_data(id_var, var_data, Time) |
| 133 | + |
| 134 | + call diag_send_complete(Time_step) |
| 135 | +enddo |
| 136 | + |
| 137 | +call diag_manager_end(Time) |
| 138 | +call fms_end |
| 139 | + |
| 140 | +contains |
| 141 | + |
| 142 | +include "../fms2_io/create_atmosphere_domain.inc" |
| 143 | +include "../fms2_io/create_land_domain.inc" |
| 144 | + |
| 145 | +!> @brief Sets up a lat/lon domain |
| 146 | +subroutine set_up_2D_domain(Domain, layout, nx, ny, io_layout) |
| 147 | + type(domain2d), intent(out) :: Domain !< 2D domain |
| 148 | + integer, intent(in) :: layout(:) !< Layout to use when setting up the domain |
| 149 | + integer, intent(in) :: nx !< Number of x points |
| 150 | + integer, intent(in) :: ny !< Number of y points |
| 151 | + integer, intent(in) :: io_layout(:) !< Io layout to use when setting up the io_domain |
| 152 | + |
| 153 | + call mpp_domains_set_stack_size(17280000) |
| 154 | + call mpp_define_domains( (/1,nx,1,ny/), layout, Domain, name='2D domain') |
| 155 | + call mpp_define_io_domain(Domain, io_layout) |
| 156 | +end subroutine set_up_2D_domain |
| 157 | + |
| 158 | +!> @brief Sets up a cube sphere domain |
| 159 | +subroutine set_up_cube_sph_domain(Domain_cube_sph, nx, ny, io_layout) |
| 160 | + type(domain2d), intent(out) :: Domain_cube_sph !< 2D domain |
| 161 | + integer, intent(in) :: nx !< Number of x points |
| 162 | + integer, intent(in) :: ny !< Number of y points |
| 163 | + integer, intent(in) :: io_layout(:) !< Io layout to use when setting up the io_domain |
| 164 | + |
| 165 | + integer :: i !< For do loops |
| 166 | + integer :: npes !< Number of pes |
| 167 | + integer, parameter :: ntiles=6 !< Number of tiles |
| 168 | + integer, dimension(4,ntiles) :: global_indices !< The global indices of each tile |
| 169 | + integer, dimension(2,ntiles) :: layout !< The layout of each tile |
| 170 | + integer, dimension(ntiles) :: pe_start !< The starting PE of each tile |
| 171 | + integer, dimension(ntiles) :: pe_end !< The ending PE of eeach tile |
| 172 | + |
| 173 | + npes = mpp_npes() |
| 174 | + |
| 175 | + !< Create the domain |
| 176 | + do i = 1,ntiles |
| 177 | + global_indices(:, i) = (/1, ny, 1, ny/) |
| 178 | + layout(:, i) = (/1, npes/ntiles/) |
| 179 | + pe_start(i) = (i-1)*(npes/ntiles) |
| 180 | + pe_end(i) = i*(npes/ntiles) - 1 |
| 181 | + end do |
| 182 | + |
| 183 | + call create_atmosphere_domain((/nx, nx, nx, nx, nx, nx/), & |
| 184 | + (/ny, ny, ny, ny, ny, ny/), & |
| 185 | + global_indices, layout, pe_start, pe_end, & |
| 186 | + io_layout, Domain_cube_sph) |
| 187 | +end subroutine set_up_cube_sph_domain |
| 188 | +end program test_modern_diag |
0 commit comments