YAC 3.13.0
Yet Another Coupler
Loading...
Searching...
No Matches
test_read_scrip_parallel.F90
Go to the documentation of this file.
1! Copyright (c) 2024 The YAC Authors
2!
3! SPDX-License-Identifier: BSD-3-Clause
4
5#include "test_macros.inc"
6
10
11PROGRAM main
12
13 use, INTRINSIC :: iso_c_binding
14 USE utest
15 USE yac_core
16 USE yac_utils
17 USE mpi
18
19 IMPLICIT NONE
20
21 INTERFACE
22 SUBROUTINE write_dummy_scrip_grid_file_c ( &
23 grid_name, grid_filename, mask_filename, &
24 with_corner, num_lon, num_lat, lon_range, lat_range ) &
25 bind( c, name='write_dummy_scrip_grid_file' )
26 use, INTRINSIC :: iso_c_binding, only : c_char, c_int, c_size_t, c_double
27 CHARACTER(KIND=c_char), DIMENSION(*) :: grid_name
28 CHARACTER(KIND=c_char), DIMENSION(*) :: grid_filename
29 CHARACTER(KIND=c_char), DIMENSION(*) :: mask_filename
30 INTEGER(KIND=c_int), value :: with_corner
31 INTEGER(KIND=c_size_t), value :: num_lon
32 INTEGER(KIND=c_size_t), value :: num_lat
33 REAL(KIND=c_double), DIMENSION(*) :: lat_range
34 REAL(KIND=c_double), DIMENSION(*) :: lon_range
35 END SUBROUTINE write_dummy_scrip_grid_file_c
36 END INTERFACE
37
38 INTERFACE
39 SUBROUTINE c_unlink ( path ) bind ( c, name='unlink' )
40 use, INTRINSIC :: iso_c_binding, only : c_char
41 CHARACTER(KIND=c_char), DIMENSION(*) :: path
42 END SUBROUTINE c_unlink
43 END INTERFACE
44
45 INTEGER :: comm_size, comm_rank
46 INTEGER :: ierror
47
48 ! ===================================================================
49
50 CALL start_test('read_scrip_parallel')
51
52 CALL mpi_init(ierror)
53
54
55 CALL mpi_comm_size(mpi_comm_world, comm_size, ierror)
56 CALL mpi_comm_rank(mpi_comm_world, comm_rank, ierror)
57
58 CALL test(comm_size == 4)
59
60 ! ===================================================================
61 ! yac_read_scrip_basic_grid_parallel
62 ! ===================================================================
63 CALL test_yac_read_scrip_basic_grid_parallel()
64
65 ! ===================================================================
66 ! yac_read_scrip_cloud_basic_grid_parallel
67 ! ===================================================================
68 CALL test_yac_read_scrip_cloud_basic_grid_parallel()
69
70 ! ===================================================================
71 ! yac_read_scrip_generic_basic_grid_parallel
72 ! ===================================================================
73 CALL test_yac_read_scrip_generic_basic_grid_parallel()
74
75 CALL mpi_finalize(ierror)
76
77 CALL stop_test
78 CALL exit_tests
79
80CONTAINS
81
82 SUBROUTINE test_yac_read_scrip_basic_grid_parallel()
83
84 IMPLICIT NONE
85
86 CHARACTER(KIND=c_char,LEN=*), PARAMETER :: grid_name = &
87 "dummy_grid" // c_null_char
88 CHARACTER(KIND=c_char,LEN=*), PARAMETER :: grid_filename = &
89 "test_read_scrip_parallel_grids.nc" // c_null_char
90 CHARACTER(KIND=c_char,LEN=*), PARAMETER :: mask_filename = &
91 "test_read_scrip_parallel_masks.nc" // c_null_char
92
93 INTEGER(KIND=C_INT), PARAMETER :: with_corner = 1_c_int
94 INTEGER(KIND=C_INT), PARAMETER :: valid_mask_value = 0_c_int
95 INTEGER(KIND=C_INT), PARAMETER :: use_ll_edges = 0_c_int
96
97 INTEGER(KIND=C_SIZE_T) :: cell_coord_idx
98 TYPE(C_PTR) :: duplicated_cell_idx
99 TYPE(C_PTR) :: orig_cell_global_id
100 INTEGER(KIND=C_SIZE_T) :: nbr_duplicated_cells
101
102 TYPE(C_PTR) :: scrip_grid
103
104 ! write dummy scrip grid file
105 IF (comm_rank == 0) &
106 CALL write_dummy_scrip_grid_file_c( &
107 grid_name, grid_filename, mask_filename, with_corner, &
108 360_c_size_t, 180_c_size_t, (/0.0_c_double, 360.0_c_double/), &
109 (/-90.0_c_double, 90.0_c_double/))
110 CALL mpi_barrier(mpi_comm_world, ierror)
111
112 scrip_grid = &
113 yac_read_scrip_basic_grid_parallel_c( &
114 grid_filename, mask_filename, mpi_comm_world, grid_name, &
115 valid_mask_value, grid_name, use_ll_edges, cell_coord_idx, &
116 duplicated_cell_idx, orig_cell_global_id, nbr_duplicated_cells)
117
118 CALL yac_free_c(duplicated_cell_idx)
119 CALL yac_free_c(orig_cell_global_id)
120
121 CALL yac_basic_grid_delete_c(scrip_grid)
122
123 ! delete dummy scrip grid file
124 CALL mpi_barrier(mpi_comm_world, ierror)
125 IF (comm_rank == 0) THEN
126 CALL c_unlink(grid_filename)
127 CALL c_unlink(mask_filename)
128 END IF
129
130 END SUBROUTINE test_yac_read_scrip_basic_grid_parallel
131
132 SUBROUTINE test_yac_read_scrip_cloud_basic_grid_parallel()
133
134 IMPLICIT NONE
135
136 CHARACTER(KIND=c_char,LEN=*), PARAMETER :: grid_name = &
137 "dummy_grid" // c_null_char
138 CHARACTER(KIND=c_char,LEN=*), PARAMETER :: grid_filename = &
139 "test_read_scrip_cloud_parallel_grids.nc" // c_null_char
140 CHARACTER(KIND=c_char,LEN=*), PARAMETER :: mask_filename = &
141 "test_read_scrip_cloud_parallel_masks.nc" // c_null_char
142
143 INTEGER(KIND=C_INT), PARAMETER :: with_corner = 0_c_int
144 INTEGER(KIND=C_INT), PARAMETER :: valid_mask_value = 0_c_int
145
146 INTEGER(KIND=C_SIZE_T) :: vertex_coord_idx
147 TYPE(C_PTR) :: duplicated_vertex_idx
148 TYPE(C_PTR) :: orig_vertex_global_id
149 INTEGER(KIND=C_SIZE_T) :: nbr_duplicated_vertices
150
151 TYPE(C_PTR) :: scrip_cloud_grid
152
153 INTEGER :: local_nbr_duplicated_vertices(1)
154 INTEGER :: global_nbr_duplicated_vertices(1)
155
156 ! write dummy scrip grid file
157 IF (comm_rank == 0) &
158 CALL write_dummy_scrip_grid_file_c( &
159 grid_name, grid_filename, mask_filename, with_corner, &
160 380_c_size_t, 180_c_size_t, (/0.0_c_double, 380.0_c_double/), &
161 (/-90.0_c_double, 90.0_c_double/))
162 CALL mpi_barrier(mpi_comm_world, ierror)
163
164 scrip_cloud_grid = &
165 yac_read_scrip_cloud_basic_grid_parallel_c( &
166 grid_filename, mask_filename, mpi_comm_world, grid_name, &
167 valid_mask_value, grid_name, vertex_coord_idx, &
168 duplicated_vertex_idx, orig_vertex_global_id, nbr_duplicated_vertices)
169
170 local_nbr_duplicated_vertices(1) = int(nbr_duplicated_vertices)
171 CALL mpi_allreduce( &
172 local_nbr_duplicated_vertices, global_nbr_duplicated_vertices, &
173 1, mpi_integer, mpi_sum, mpi_comm_world, ierror)
174 CALL test(global_nbr_duplicated_vertices(1) == 20 * 180)
175
176 CALL yac_free_c(duplicated_vertex_idx)
177 CALL yac_free_c(orig_vertex_global_id)
178
179 CALL yac_basic_grid_delete_c(scrip_cloud_grid)
180
181 ! delete dummy scrip grid file
182 CALL mpi_barrier(mpi_comm_world, ierror)
183 IF (comm_rank == 0) THEN
184 CALL c_unlink(grid_filename)
185 CALL c_unlink(mask_filename)
186 END IF
187
188 END SUBROUTINE test_yac_read_scrip_cloud_basic_grid_parallel
189
190 SUBROUTINE test_yac_read_scrip_generic_basic_grid_parallel()
191
192 IMPLICIT NONE
193
194 CHARACTER(KIND=c_char,LEN=*), PARAMETER :: grid_name = &
195 "dummy_grid" // c_null_char
196 CHARACTER(KIND=c_char,LEN=*), PARAMETER :: grid_filename = &
197 "test_read_scrip_parallel_2_grids.nc" // c_null_char
198 CHARACTER(KIND=c_char,LEN=*), PARAMETER :: mask_filename = &
199 "test_read_scrip_parallel_2_masks.nc" // c_null_char
200
201 INTEGER(KIND=C_INT) :: with_corner
202 INTEGER(KIND=C_INT), PARAMETER :: valid_mask_value = 0_c_int
203 INTEGER(KIND=C_INT), PARAMETER :: use_ll_edges = 0_c_int
204
205 INTEGER(KIND=C_SIZE_T) :: cell_coord_idx
206 TYPE(C_PTR) :: duplicated_cell_idx
207 TYPE(C_PTR) :: orig_cell_global_id
208 INTEGER(KIND=C_SIZE_T) :: nbr_duplicated_cells
209
210 INTEGER(KIND=C_SIZE_T) :: vertex_coord_idx
211 TYPE(C_PTR) :: duplicated_vertex_idx
212 TYPE(C_PTR) :: orig_vertex_global_id
213 INTEGER(KIND=C_SIZE_T) :: nbr_duplicated_vertices
214
215 INTEGER(KIND=C_INT) :: point_location
216
217 TYPE(C_PTR) :: scrip_grid
218 TYPE(C_PTR) :: scrip_cloud_grid
219
220 ! write dummy scrip grid file
221 IF (comm_rank == 0) THEN
222 with_corner = 1_c_int
223 CALL write_dummy_scrip_grid_file_c( &
224 grid_name, grid_filename, mask_filename, with_corner, &
225 360_c_size_t, 180_c_size_t, (/0.0_c_double, 360.0_c_double/), &
226 (/-90.0_c_double, 90.0_c_double/))
227 END IF
228 CALL mpi_barrier(mpi_comm_world, ierror)
229
230 scrip_grid = &
231 yac_read_scrip_generic_basic_grid_parallel_c( &
232 grid_filename, mask_filename, mpi_comm_world, grid_name, &
233 valid_mask_value, grid_name, use_ll_edges, cell_coord_idx, &
234 duplicated_cell_idx, orig_cell_global_id, nbr_duplicated_cells, &
235 point_location)
236
237 CALL test(point_location == int(yac_loc_cell, c_int))
238
239 CALL yac_free_c(duplicated_cell_idx)
240 CALL yac_free_c(orig_cell_global_id)
241
242 CALL yac_basic_grid_delete_c(scrip_grid)
243
244 ! delete dummy scrip grid file
245 CALL mpi_barrier(mpi_comm_world, ierror)
246 IF (comm_rank == 0) THEN
247 CALL c_unlink(grid_filename)
248 CALL c_unlink(mask_filename)
249 END IF
250
251 CALL mpi_barrier(mpi_comm_world, ierror)
252
253 ! write dummy scrip cloud grid file
254 IF (comm_rank == 0) THEN
255 with_corner = 0_c_int
256 CALL write_dummy_scrip_grid_file_c( &
257 grid_name, grid_filename, mask_filename, with_corner, &
258 380_c_size_t, 180_c_size_t, (/0.0_c_double, 380.0_c_double/), &
259 (/-90.0_c_double, 90.0_c_double/))
260 END IF
261 CALL mpi_barrier(mpi_comm_world, ierror)
262
263 scrip_cloud_grid = &
264 yac_read_scrip_generic_basic_grid_parallel_c( &
265 grid_filename, mask_filename, mpi_comm_world, grid_name, &
266 valid_mask_value, grid_name, use_ll_edges, vertex_coord_idx, &
267 duplicated_vertex_idx, orig_vertex_global_id, nbr_duplicated_vertices, &
268 point_location)
269
270 CALL test(point_location == int(yac_loc_corner, c_int))
271
272 CALL yac_free_c(duplicated_vertex_idx)
273 CALL yac_free_c(orig_vertex_global_id)
274
275 CALL yac_basic_grid_delete_c(scrip_cloud_grid)
276
277 ! delete dummy scrip grid file
278 CALL mpi_barrier(mpi_comm_world, ierror)
279 IF (comm_rank == 0) THEN
280 CALL c_unlink(grid_filename)
281 CALL c_unlink(mask_filename)
282 END IF
283
284 END SUBROUTINE test_yac_read_scrip_generic_basic_grid_parallel
285
286END PROGRAM main
yac_core::yac_basic_grid_delete_c
Definition yac_core.F90:223
yac_utils::yac_free_c
Definition yac_utils.F90:30
yac_utils::yac_read_scrip_basic_grid_parallel_c
Definition yac_utils.F90:440
yac_utils::yac_read_scrip_cloud_basic_grid_parallel_c
Definition yac_utils.F90:524
yac_utils::yac_read_scrip_generic_basic_grid_parallel_c
Definition yac_utils.F90:466
utest
Definition utest.F90:5
utest::start_test
subroutine, public start_test(name)
Definition utest.F90:20
utest::stop_test
subroutine, public stop_test()
Definition utest.F90:27
utest::exit_tests
subroutine, public exit_tests()
Definition utest.F90:81
yac_core
Definition yac_core.F90:10
yac_core::yac_loc_cell
@ yac_loc_cell
Definition yac_core.F90:33
yac_core::yac_loc_corner
@ yac_loc_corner
Definition yac_core.F90:34
yac_utils
Definition yac_utils.F90:10