YAC 3.18.0
Yet Another Coupler
Loading...
Searching...
No Matches
test_restart_dble.F90
Go to the documentation of this file.
1! Copyright (c) 2024 The YAC Authors
2!
3! SPDX-License-Identifier: BSD-3-Clause
4
8
9#define DUMMY_VALUE (-1337.0d0)
10
11#include "test_macros.inc"
12
13!
14! This tests checks the support for multiple parallel YAC instances.
15! There are three main components and one dummy component. The dummy component
16! does not take part in any coupling.
17!
18! All four components are registered in the default YAC instance.
19!
20! The three active components couple to each other.
21!
22! Each active component shares one process with each of the two other active
23! components.
24!
25! Each active component pair generates their own YAC instance.
26!
27! Each active component has its own YAC instance in which one of its processes
28! generates its own component.
29!
30! The whole setup is run twice in order to simulate the restarting of YAC
31! instances.
32!
33
34MODULE field_data
35 IMPLICIT NONE
36 DOUBLE PRECISION, ALLOCATABLE, PUBLIC :: field_out_data(:,:)
37 DOUBLE PRECISION, ALLOCATABLE, PUBLIC :: field_in_data(:,:)
38 INTEGER, PUBLIC :: field_data_size
39 INTEGER, PUBLIC :: point_id = huge(0)
40 CHARACTER(LEN=64), PUBLIC :: config_filename
41END MODULE
42
43PROGRAM main
44
45 USE mpi
46 USE utest
47 USE yac
48 USE field_data
49 use, INTRINSIC :: iso_c_binding, only : c_null_char
50
51 IMPLICIT NONE
52
53 INTEGER :: global_rank, ierror
54
55 INTEGER, PARAMETER :: max_opt_arg_len = 1024
56 CHARACTER(max_opt_arg_len) :: grid_dir
57 INTEGER :: arg_len
58
59 INTERFACE
60
61 SUBROUTINE c_unlink ( path ) bind ( c, name='unlink' )
62
63 use, INTRINSIC :: iso_c_binding, only : c_char
64
65 CHARACTER(KIND=c_char), DIMENSION(*) :: path
66
67 END SUBROUTINE c_unlink
68
69 END INTERFACE
70
71 ! ===================================================================
72
73 CALL start_test('dummy_restart_dble')
74
75 CALL test(command_argument_count() == 1)
76 CALL get_command_argument(1, grid_dir, arg_len)
77
78 config_filename = 'test_restart_dble.yaml'
79
80 ! run the models multiple time to check whether YAC can be restarted
81
82 ! no coupling
83 CALL run_model_config(.false., .false., .false., grid_dir)
84 CALL run_model_config(.false., .false., .true., grid_dir)
85 ! coupling only in one direction
86 CALL run_model_config(.true., .false., .false., grid_dir)
87 CALL run_model_config(.true., .false., .true., grid_dir)
88 ! no coupling
89 CALL run_model_config(.false., .true., .false., grid_dir)
90 CALL run_model_config(.false., .true., .true., grid_dir)
91 ! coupling in both direction
92 CALL run_model_config(.true., .true., .false., grid_dir)
93 CALL run_model_config(.true., .true., .true., grid_dir)
94
95 DEALLOCATE(field_out_data)
96 DEALLOCATE(field_in_data)
97
98 CALL mpi_comm_rank(mpi_comm_world, global_rank, ierror)
99 IF (global_rank == 0) CALL c_unlink(trim(config_filename) // c_null_char)
100
101 CALL yac_ffinalize()
102
103 CALL stop_test
104 CALL exit_tests
105
106CONTAINS
107
108 SUBROUTINE error_exit ()
109
110 USE mpi, ONLY : mpi_abort, mpi_comm_world
111 USE utest
112
113 INTEGER :: ierror
114
115 CALL test ( .false. )
116 CALL stop_test
117 CALL exit_tests
118 CALL mpi_abort ( mpi_comm_world, 999, ierror )
119
120 END SUBROUTINE error_exit
121
122 SUBROUTINE run_model_config( &
123 icon_to_cube, cube_to_icon, config_from_file, grid_dir)
124
125 USE mpi
126
127 IMPLICIT NONE
128
129 LOGICAL, INTENT(IN) :: icon_to_cube
130 LOGICAL, INTENT(IN) :: cube_to_icon
131 LOGICAL, INTENT(IN) :: config_from_file
132 CHARACTER (LEN=*) :: grid_dir
133
134 INTEGER :: ierror, info
135 INTEGER :: global_rank, global_size
136 INTEGER :: local_comm, local_rank, local_size
137 LOGICAL :: is_icon
138
139 INTEGER :: comp_id
140 INTEGER :: field_out_id, field_in_id
141 LOGICAL :: receives_data
142 INTEGER :: t, i
143 INTEGER :: interp_stack_id
144 INTEGER, PARAMETER :: collection_size = 1
145
146 CHARACTER (LEN=:), ALLOCATABLE :: config
147
148 INTERFACE
149 SUBROUTINE generate_icon_grid(comm_rank, comm_size, grid_dir)
150 INTEGER, INTENT(IN) :: comm_rank
151 INTEGER, INTENT(IN) :: comm_size
152 CHARACTER (LEN=*) :: grid_dir
153 END SUBROUTINE generate_icon_grid
154 SUBROUTINE generate_cube_grid(comm_rank, comm_size)
155 INTEGER, INTENT(IN) :: comm_rank
156 INTEGER, INTENT(IN) :: comm_size
157 END SUBROUTINE generate_cube_grid
158 END INTERFACE
159
160 CALL yac_finit()
161 CALL mpi_comm_rank(mpi_comm_world, global_rank, ierror)
162 CALL mpi_comm_size(mpi_comm_world, global_size, ierror)
163
164 CALL yac_fdef_calendar(yac_proleptic_gregorian)
165 CALL yac_fdef_datetime( &
166 "+1800-01-01T00:00:00.000", "+2100-01-01T00:00:00.000")
167
168 IF (global_size < 3) THEN
169 WRITE ( * , * ) "Wrong number of processes (should be at least 3)"
170 CALL error_exit
171 ENDIF
172
173 is_icon = global_rank < (global_size / 2)
174
175 ! register component
176 CALL yac_fdef_comp(merge('icon', 'cube', is_icon), comp_id)
177
178 CALL yac_fget_comp_comm(comp_id, local_comm)
179 CALL mpi_comm_rank(local_comm, local_rank, ierror)
180 CALL mpi_comm_size(local_comm, local_size, ierror)
181 CALL mpi_comm_free(local_comm, ierror)
182
183 ! if no points have been registered yet
184 IF (point_id == huge(point_id)) THEN
185 IF (is_icon) THEN
186 CALL generate_icon_grid(local_rank, local_size, grid_dir)
187 ELSE
188 CALL generate_cube_grid(local_rank, local_size)
189 END IF
190 END IF
191
192 ! register grid
193 IF (is_icon) THEN
194 receives_data = cube_to_icon
195 CALL yac_fdef_field( &
196 'icon_to_cube', comp_id, (/point_id/), 1, 1, "1", &
197 yac_time_unit_second, field_out_id)
198 CALL yac_fdef_field( &
199 'cube_to_icon', comp_id, (/point_id/), 1, 1, "1", &
200 yac_time_unit_second, field_in_id)
201 ELSE
202 receives_data = icon_to_cube
203 CALL yac_fdef_field( &
204 'cube_to_icon', comp_id, (/point_id/), 1, 1, "1", &
205 yac_time_unit_second, field_out_id)
206 CALL yac_fdef_field( &
207 'icon_to_cube', comp_id, (/point_id/), 1, 1, "1", &
208 yac_time_unit_second, field_in_id)
209 END IF
210
211 ! end definition phase
212 CALL yac_fsync_def()
213
214 IF (config_from_file) THEN
215
216 CALL yac_fread_config_yaml(config_filename)
217 CALL yac_fenddef()
218
219 ELSE
220
221 ! generate an interpolation interpolation stack
222 CALL yac_fget_interp_stack_config(interp_stack_id)
223 CALL yac_fadd_interp_stack_config_conservative( &
224 interp_stack_id, 1, 0, 0, 0)
225
226 ! generate couplings
227 IF (icon_to_cube .AND. .NOT. is_icon) THEN
228 CALL yac_fdef_couple( &
229 'icon', 'icon', 'icon_to_cube', &
230 'cube', 'cube', 'icon_to_cube', &
231 '1', yac_time_unit_second, yac_reduction_time_none, &
232 interp_stack_id)
233 END IF
234 IF (cube_to_icon .AND. is_icon) THEN
235 CALL yac_fdef_couple( &
236 'cube', 'cube', 'cube_to_icon', &
237 'icon', 'icon', 'cube_to_icon', &
238 '1', yac_time_unit_second, yac_reduction_time_none, &
239 interp_stack_id)
240 END IF
241
242 CALL yac_ffree_interp_stack_config(interp_stack_id)
243
244 CALL yac_fenddef(yac_yaml_emitter_default_f, config)
245
246 IF (global_rank == 0) THEN
247 open(unit=999, file=config_filename, status='replace', &
248 form='formatted', action='write')
249 write(999,"(A)") config
250 close(999)
251 END IF
252
253 DEALLOCATE(config)
254 END IF
255
256 DO t = 1, 10
257
258 CALL yac_fput( &
259 field_out_id, SIZE(field_out_data, 1), collection_size, &
260 field_out_data, info, ierror)
261
262 field_in_data = dummy_value
263 CALL yac_fget( &
264 field_in_id, SIZE(field_in_data, 1), collection_size, &
265 field_in_data, info, ierror)
266
267 DO i = 1, field_data_size
268
269 IF (receives_data) THEN
270 CALL test(abs(field_in_data(i,1) - field_out_data(i,1)) < 0.001)
271 ELSE
272 CALL test(field_in_data(i,1) == dummy_value)
273 END IF
274 END DO
275 END DO
276
277 CALL yac_fcleanup()
278
279 END SUBROUTINE run_model_config
280
281END PROGRAM
282
283SUBROUTINE generate_icon_grid(comm_rank, comm_size, grid_dir)
284
285 USE yac
286 USE field_data, ONLY: field_out_data, field_in_data, field_data_size, point_id
287 use, INTRINSIC :: iso_c_binding, only : c_loc
288
289 IMPLICIT NONE
290
291 INTERFACE
292
293 SUBROUTINE c_free ( ptr ) bind ( c, NAME='free' )
294
295 use, INTRINSIC :: iso_c_binding, only : c_ptr
296
297 TYPE ( c_ptr ), INTENT(IN), VALUE :: ptr
298
299 END SUBROUTINE c_free
300
301 END INTERFACE
302
303 INTEGER, INTENT(IN) :: comm_rank
304 INTEGER, INTENT(IN) :: comm_size
305 CHARACTER (LEN=*) :: grid_dir
306
307 INTEGER :: grid_id
308
309 INTEGER :: nbr_vertices
310 INTEGER :: nbr_cells
311 INTEGER, POINTER :: num_vertices_per_cell(:)
312 INTEGER, POINTER :: cell_to_vertex(:)
313 DOUBLE PRECISION, POINTER :: x_vertices(:)
314 DOUBLE PRECISION, POINTER :: y_vertices(:)
315 DOUBLE PRECISION, POINTER :: x_cells(:)
316 DOUBLE PRECISION, POINTER :: y_cells(:)
317
318 INTEGER, POINTER :: cell_mask_int(:)
319 INTEGER, POINTER :: global_cell_id(:)
320 INTEGER, POINTER :: cell_core_mask(:)
321 INTEGER, POINTER :: global_corner_id(:)
322 INTEGER, POINTER :: corner_core_mask(:)
323
324 LOGICAL, ALLOCATABLE :: cell_mask(:)
325
326 CALL yac_read_part_icon_grid_information( &
327 trim(grid_dir) // 'icon_grid_R02B01.nc', nbr_vertices, nbr_cells, &
328 num_vertices_per_cell, cell_to_vertex, x_vertices, y_vertices, &
329 x_cells, y_cells, global_cell_id, cell_mask_int, cell_core_mask, &
330 global_corner_id, corner_core_mask, comm_rank, comm_size)
331
332 ALLOCATE(cell_mask(nbr_cells))
333 cell_mask = .true.
334
335 CALL yac_fdef_grid( &
336 'icon', nbr_vertices, nbr_cells, sum(num_vertices_per_cell), &
337 num_vertices_per_cell, x_vertices, y_vertices, cell_to_vertex, grid_id)
338
339 CALL yac_fset_global_index(global_corner_id, yac_location_corner, grid_id)
340 CALL yac_fset_core_mask(corner_core_mask == 1, yac_location_corner, grid_id)
341 CALL yac_fset_global_index(global_cell_id, yac_location_cell, grid_id)
342 CALL yac_fset_core_mask(cell_core_mask == 1, yac_location_cell, grid_id)
343
344 CALL yac_fdef_points( &
345 grid_id, nbr_cells, yac_location_cell, x_cells, y_cells, point_id)
346
347 CALL yac_fset_mask(cell_mask, point_id)
348
349 ALLOCATE(field_out_data(nbr_cells,1))
350 field_data_size = nbr_cells
351 field_out_data(:,1) = &
352 merge(test_harmonic(x_cells(:), y_cells(:)), &
353 dummy_value, cell_core_mask == 1)
354 ALLOCATE(field_in_data(nbr_cells,1))
355
356 IF (ASSOCIATED(num_vertices_per_cell)) CALL c_free(c_loc(num_vertices_per_cell(1)))
357 IF (ASSOCIATED(cell_to_vertex)) CALL c_free(c_loc(cell_to_vertex(1)))
358 IF (ASSOCIATED(x_vertices)) CALL c_free(c_loc(x_vertices(1)))
359 IF (ASSOCIATED(y_vertices)) CALL c_free(c_loc(y_vertices(1)))
360 IF (ASSOCIATED(x_cells)) CALL c_free(c_loc(x_cells(1)))
361 IF (ASSOCIATED(y_cells)) CALL c_free(c_loc(y_cells(1)))
362
363 IF (ASSOCIATED(cell_mask_int)) CALL c_free(c_loc(cell_mask_int(1)))
364 IF (ASSOCIATED(global_cell_id)) CALL c_free(c_loc(global_cell_id(1)))
365 IF (ASSOCIATED(cell_core_mask)) CALL c_free(c_loc(cell_core_mask(1)))
366 IF (ASSOCIATED(global_corner_id)) CALL c_free(c_loc(global_corner_id(1)))
367 IF (ASSOCIATED(corner_core_mask)) CALL c_free(c_loc(corner_core_mask(1)))
368
369CONTAINS
370
371 ELEMENTAL DOUBLE PRECISION FUNCTION test_harmonic ( lon, lat )
372 DOUBLE PRECISION, INTENT(IN) :: lon, lat
373
374 DOUBLE PRECISION, PARAMETER :: YAC_RAD = 0.017453292519943 ! M_PI / 180.0
375 test_harmonic = &
376 2.0 + ((sin(2.0 * lat * yac_rad))**16.0 * cos(16.0 * lon * yac_rad))
377 END FUNCTION test_harmonic
378
379 SUBROUTINE yac_read_part_icon_grid_information ( grid_file, &
380 nbr_vertices, &
381 nbr_cells, &
382 num_vertices_per_cell, &
383 cell_to_vertex, &
384 x_vertices, &
385 y_vertices, &
386 x_cells, &
387 y_cells, &
388 global_cell_ids, &
389 cell_mask, &
390 cell_core_mask, &
391 global_corner_ids, &
392 corner_core_mask, &
393 comm_rank, &
394 comm_size )
395
396 USE iso_c_binding, ONLY: c_int, c_ptr, c_f_pointer, c_null_char
397
398 IMPLICIT NONE
399
400 INTERFACE
401
402 SUBROUTINE yac_read_part_icon_grid_information_c ( grid_file, &
403 nbr_vertices, &
404 nbr_cells, &
405 num_vertices_per_cell, &
406 cell_to_vertex, &
407 x_vertices, y_vertices, &
408 x_cells, y_cells, &
409 global_cell_ids, &
410 cell_mask, &
411 cell_core_mask, &
412 global_corner_ids, &
413 corner_core_mask, &
414 comm_rank, &
415 comm_size ) &
416 bind( c, name='yac_read_part_icon_grid_information' )
417
418 use, INTRINSIC :: iso_c_binding, only : c_int, c_char, c_ptr
419
420 CHARACTER ( kind=c_char), DIMENSION(*) :: grid_file
421 INTEGER ( kind=c_int ) :: nbr_vertices
422 INTEGER ( kind=c_int ) :: nbr_cells
423 TYPE (c_ptr ) :: num_vertices_per_cell
424 TYPE (c_ptr ) :: cell_to_vertex
425 TYPE (c_ptr ) :: x_vertices
426 TYPE (c_ptr ) :: y_vertices
427 TYPE (c_ptr ) :: x_cells
428 TYPE (c_ptr ) :: y_cells
429 TYPE (c_ptr ) :: global_cell_ids
430 TYPE (c_ptr ) :: cell_mask
431 TYPE (c_ptr ) :: cell_core_mask
432 TYPE (c_ptr ) :: global_corner_ids
433 TYPE (c_ptr ) :: corner_core_mask
434 INTEGER ( kind=c_int ), VALUE :: comm_rank
435 INTEGER ( kind=c_int ), VALUE :: comm_size
436
437 END SUBROUTINE yac_read_part_icon_grid_information_c
438
439 END INTERFACE
440
441 CHARACTER (LEN=*) :: grid_file
442 INTEGER ( kind=c_int ) :: nbr_vertices
443 INTEGER ( kind=c_int ) :: nbr_cells
444 INTEGER, POINTER :: num_vertices_per_cell(:)
445 INTEGER, POINTER :: cell_to_vertex(:)
446 DOUBLE PRECISION, POINTER :: x_vertices(:)
447 DOUBLE PRECISION, POINTER :: y_vertices(:)
448 DOUBLE PRECISION, POINTER :: x_cells(:)
449 DOUBLE PRECISION, POINTER :: y_cells(:)
450 INTEGER, POINTER :: global_cell_ids(:)
451 INTEGER, POINTER :: cell_mask(:)
452 INTEGER, POINTER :: cell_core_mask(:)
453 INTEGER, POINTER :: global_corner_ids(:)
454 INTEGER, POINTER :: corner_core_mask(:)
455 INTEGER ( kind=c_int ) :: comm_rank
456 INTEGER ( kind=c_int ) :: comm_size
457
458 TYPE(c_ptr) :: num_vertices_per_cell_
459 TYPE(c_ptr) :: cell_to_vertex_
460 TYPE(c_ptr) :: x_vertices_
461 TYPE(c_ptr) :: y_vertices_
462 TYPE(c_ptr) :: x_cells_
463 TYPE(c_ptr) :: y_cells_
464 TYPE(c_ptr) :: global_cell_ids_
465 TYPE(c_ptr) :: cell_mask_
466 TYPE(c_ptr) :: cell_core_mask_
467 TYPE(c_ptr) :: global_corner_ids_
468 TYPE(c_ptr) :: corner_core_mask_
469
470 CALL yac_read_part_icon_grid_information_c ( trim(grid_file) // c_null_char, &
471 nbr_vertices, &
472 nbr_cells, &
473 num_vertices_per_cell_, &
474 cell_to_vertex_, &
475 x_vertices_, y_vertices_, &
476 x_cells_, y_cells_, &
477 global_cell_ids_, &
478 cell_mask_, &
479 cell_core_mask_, &
480 global_corner_ids_, &
481 corner_core_mask_, &
482 comm_rank, &
483 comm_size )
484
485 CALL c_f_pointer(num_vertices_per_cell_, num_vertices_per_cell, (/nbr_cells/))
486 CALL c_f_pointer(cell_to_vertex_, cell_to_vertex, (/sum(num_vertices_per_cell)/))
487 CALL c_f_pointer(x_vertices_, x_vertices, (/nbr_vertices/))
488 CALL c_f_pointer(y_vertices_, y_vertices, (/nbr_vertices/))
489 CALL c_f_pointer(x_cells_, x_cells, (/nbr_cells/))
490 CALL c_f_pointer(y_cells_, y_cells, (/nbr_cells/))
491 CALL c_f_pointer(global_cell_ids_, global_cell_ids, (/nbr_cells/))
492 CALL c_f_pointer(cell_mask_, cell_mask, (/nbr_cells/))
493 CALL c_f_pointer(cell_core_mask_, cell_core_mask, (/nbr_cells/))
494 CALL c_f_pointer(global_corner_ids_, global_corner_ids, (/nbr_vertices/))
495 CALL c_f_pointer(corner_core_mask_, corner_core_mask, (/nbr_vertices/))
496
497 cell_to_vertex = cell_to_vertex + 1
498
499 END SUBROUTINE yac_read_part_icon_grid_information
500
501END SUBROUTINE generate_icon_grid
502
503! ----------------------------------------------------------
504
505SUBROUTINE generate_cube_grid(comm_rank, comm_size)
506
507 USE yac
508 USE field_data, ONLY: field_out_data, field_in_data, field_data_size, point_id
509 use, INTRINSIC :: iso_c_binding, only : c_loc
510
511 IMPLICIT NONE
512
513 INTERFACE
514
515 SUBROUTINE c_free ( ptr ) bind ( c, NAME='free' )
516
517 use, INTRINSIC :: iso_c_binding, only : c_ptr
518
519 TYPE ( c_ptr ), INTENT(IN), VALUE :: ptr
520
521 END SUBROUTINE c_free
522
523 END INTERFACE
524
525 INTEGER, INTENT(IN) :: comm_rank
526 INTEGER, INTENT(IN) :: comm_size
527
528 INTEGER :: grid_id
529
530 INTEGER, PARAMETER :: n = 50
531
532 INTEGER :: nbr_vertices
533 INTEGER :: nbr_cells
534 INTEGER, POINTER :: num_vertices_per_cell(:)
535 INTEGER, POINTER :: cell_to_vertex(:)
536 DOUBLE PRECISION, POINTER :: x_vertices(:)
537 DOUBLE PRECISION, POINTER :: y_vertices(:)
538 DOUBLE PRECISION, POINTER :: x_cells(:)
539 DOUBLE PRECISION, POINTER :: y_cells(:)
540
541 INTEGER, POINTER :: cell_core_mask(:)
542 INTEGER, POINTER :: corner_core_mask(:)
543 INTEGER, POINTER :: global_cell_id(:)
544 INTEGER, POINTER :: global_corner_id(:)
545
546 CALL yac_generate_part_cube_grid_information( &
547 n, nbr_vertices, nbr_cells, num_vertices_per_cell, cell_to_vertex, &
548 x_vertices, y_vertices, x_cells, y_cells, global_cell_id, &
549 cell_core_mask, global_corner_id, corner_core_mask, &
550 comm_rank, comm_size)
551
552 CALL yac_fdef_grid( &
553 'cube', nbr_vertices, nbr_cells, sum(num_vertices_per_cell), &
554 num_vertices_per_cell, x_vertices, y_vertices, cell_to_vertex, grid_id)
555
556 CALL yac_fset_global_index(global_corner_id, yac_location_corner, grid_id)
557 CALL yac_fset_core_mask(corner_core_mask == 1, yac_location_corner, grid_id)
558 CALL yac_fset_global_index(global_cell_id, yac_location_cell, grid_id)
559 CALL yac_fset_core_mask(cell_core_mask == 1, yac_location_cell, grid_id)
560
561 CALL yac_fdef_points( &
562 grid_id, nbr_cells, yac_location_cell, x_cells, y_cells, point_id)
563
564 ALLOCATE(field_out_data(nbr_cells,1))
565 field_data_size = nbr_cells
566 field_out_data(:,1) = &
567 merge(test_harmonic(x_cells(:), y_cells(:)), &
568 dummy_value, cell_core_mask == 1)
569 ALLOCATE(field_in_data(nbr_cells,1))
570
571 IF (ASSOCIATED(num_vertices_per_cell)) CALL c_free(c_loc(num_vertices_per_cell(1)))
572 IF (ASSOCIATED(cell_to_vertex)) CALL c_free(c_loc(cell_to_vertex(1)))
573 IF (ASSOCIATED(x_vertices)) CALL c_free(c_loc(x_vertices(1)))
574 IF (ASSOCIATED(y_vertices)) CALL c_free(c_loc(y_vertices(1)))
575 IF (ASSOCIATED(x_cells)) CALL c_free(c_loc(x_cells(1)))
576 IF (ASSOCIATED(y_cells)) CALL c_free(c_loc(y_cells(1)))
577
578 IF (ASSOCIATED(global_cell_id)) CALL c_free(c_loc(global_cell_id(1)))
579 IF (ASSOCIATED(cell_core_mask)) CALL c_free(c_loc(cell_core_mask(1)))
580 IF (ASSOCIATED(global_corner_id)) CALL c_free(c_loc(global_corner_id(1)))
581 IF (ASSOCIATED(corner_core_mask)) CALL c_free(c_loc(corner_core_mask(1)))
582
583CONTAINS
584
585 ELEMENTAL DOUBLE PRECISION FUNCTION test_harmonic ( lon, lat )
586 DOUBLE PRECISION, INTENT(IN) :: lon, lat
587
588 DOUBLE PRECISION, PARAMETER :: YAC_RAD = 0.017453292519943 ! M_PI / 180.0
589 test_harmonic = &
590 2.0 + ((sin(2.0 * lat * yac_rad))**16.0 * cos(16.0 * lon * yac_rad))
591 END FUNCTION test_harmonic
592
593 SUBROUTINE yac_generate_part_cube_grid_information ( n, &
594 nbr_vertices, &
595 nbr_cells, &
596 num_vertices_per_cell, &
597 cell_to_vertex, &
598 x_vertices, &
599 y_vertices, &
600 x_cells, &
601 y_cells, &
602 global_cell_ids, &
603 cell_core_mask, &
604 global_corner_ids, &
605 corner_core_mask, &
606 comm_rank, &
607 comm_size )
608
609 USE iso_c_binding, ONLY: c_int, c_ptr, c_f_pointer
610
611 IMPLICIT NONE
612
613 INTERFACE
614
615 SUBROUTINE yac_generate_part_cube_grid_information_c ( n, &
616 nbr_vertices, &
617 nbr_cells, &
618 num_vertices_per_cell, &
619 cell_to_vertex, &
620 x_vertices, y_vertices, &
621 x_cells, y_cells, &
622 global_cell_ids, &
623 cell_core_mask, &
624 global_corner_ids, &
625 corner_core_mask, &
626 comm_rank, &
627 comm_size ) &
628 bind( c, name='yac_generate_part_cube_grid_information' )
629
630 use, INTRINSIC :: iso_c_binding, only : c_int, c_ptr
631
632 INTEGER ( kind=c_int ), VALUE :: n
633 INTEGER ( kind=c_int ) :: nbr_vertices
634 INTEGER ( kind=c_int ) :: nbr_cells
635 TYPE(c_ptr) :: num_vertices_per_cell
636 TYPE(c_ptr) :: cell_to_vertex
637 TYPE(c_ptr) :: x_vertices
638 TYPE(c_ptr) :: y_vertices
639 TYPE(c_ptr) :: x_cells
640 TYPE(c_ptr) :: y_cells
641 TYPE(c_ptr) :: global_cell_ids
642 TYPE(c_ptr) :: cell_core_mask
643 TYPE(c_ptr) :: global_corner_ids
644 TYPE(c_ptr) :: corner_core_mask
645 INTEGER ( kind=c_int ), VALUE :: comm_rank
646 INTEGER ( kind=c_int ), VALUE :: comm_size
647
648 END SUBROUTINE yac_generate_part_cube_grid_information_c
649
650 END INTERFACE
651
652 INTEGER ( kind=c_int ) :: n
653 INTEGER ( kind=c_int ) :: nbr_vertices
654 INTEGER ( kind=c_int ) :: nbr_cells
655 INTEGER ( kind=c_int ), POINTER :: num_vertices_per_cell(:)
656 INTEGER ( kind=c_int ), POINTER :: cell_to_vertex(:)
657 DOUBLE PRECISION, POINTER :: x_vertices(:)
658 DOUBLE PRECISION, POINTER :: y_vertices(:)
659 DOUBLE PRECISION, POINTER :: x_cells(:)
660 DOUBLE PRECISION, POINTER :: y_cells(:)
661 INTEGER ( kind=c_int ), POINTER :: global_cell_ids(:)
662 INTEGER ( kind=c_int ), POINTER :: cell_core_mask(:)
663 INTEGER ( kind=c_int ), POINTER :: global_corner_ids(:)
664 INTEGER ( kind=c_int ), POINTER :: corner_core_mask(:)
665 INTEGER ( kind=c_int ) :: comm_rank
666 INTEGER ( kind=c_int ) :: comm_size
667
668 TYPE(c_ptr) :: num_vertices_per_cell_
669 TYPE(c_ptr) :: cell_to_vertex_
670 TYPE(c_ptr) :: x_vertices_
671 TYPE(c_ptr) :: y_vertices_
672 TYPE(c_ptr) :: x_cells_
673 TYPE(c_ptr) :: y_cells_
674 TYPE(c_ptr) :: global_cell_ids_
675 TYPE(c_ptr) :: cell_core_mask_
676 TYPE(c_ptr) :: global_corner_ids_
677 TYPE(c_ptr) :: corner_core_mask_
678
679 CALL yac_generate_part_cube_grid_information_c ( n, &
680 nbr_vertices, &
681 nbr_cells, &
682 num_vertices_per_cell_, &
683 cell_to_vertex_, &
684 x_vertices_, y_vertices_, &
685 x_cells_, y_cells_, &
686 global_cell_ids_, &
687 cell_core_mask_, &
688 global_corner_ids_, &
689 corner_core_mask_, &
690 comm_rank, &
691 comm_size )
692
693 CALL c_f_pointer(num_vertices_per_cell_, num_vertices_per_cell, (/nbr_cells/))
694 CALL c_f_pointer(cell_to_vertex_, cell_to_vertex, (/sum(num_vertices_per_cell)/))
695 CALL c_f_pointer(x_vertices_, x_vertices, (/nbr_vertices/))
696 CALL c_f_pointer(y_vertices_, y_vertices, (/nbr_vertices/))
697 CALL c_f_pointer(x_cells_, x_cells, (/nbr_cells/))
698 CALL c_f_pointer(y_cells_, y_cells, (/nbr_cells/))
699 CALL c_f_pointer(global_cell_ids_, global_cell_ids, (/nbr_cells/))
700 CALL c_f_pointer(cell_core_mask_, cell_core_mask, (/nbr_cells/))
701 CALL c_f_pointer(global_corner_ids_, global_corner_ids, (/nbr_vertices/))
702 CALL c_f_pointer(corner_core_mask_, corner_core_mask, (/nbr_vertices/))
703
704 cell_to_vertex = cell_to_vertex + 1
705
706 END SUBROUTINE yac_generate_part_cube_grid_information
707
708END SUBROUTINE generate_cube_grid
yac_generate_part_cube_grid_information
void yac_generate_part_cube_grid_information(unsigned n, unsigned *nbr_vertices, unsigned *nbr_cells, unsigned **num_vertices_per_cell, unsigned **cell_to_vertex, double **x_vertices, double **y_vertices, double **x_cells, double **y_cells, int **global_cell_id, int **cell_core_mask, int **global_corner_id, int **corner_core_mask, int rank, int size)
Definition generate_cubed_sphere.c:566
yac::yac_fadd_interp_stack_config_conservative
Definition yac_module.F90:3564
yac::yac_fcleanup
Fortran interface for the coupler cleanup before restart.
Definition yac_module.F90:442
yac::yac_fdef_calendar
Definition yac_module.F90:615
yac::yac_fdef_comp
Definition yac_module.F90:524
yac::yac_fdef_couple
Fortran interface for definition of a couple.
Definition yac_module.F90:3655
yac::yac_fdef_datetime
Fortran interface for the definition of time parameters.
Definition yac_module.F90:594
yac::yac_fdef_field
Fortran interface for the definition of coupling fields using default masks.
Definition yac_module.F90:1724
yac::yac_fdef_grid
Fortran interface for the definition of grids.
Definition yac_module.F90:671
yac::yac_fdef_points
Fortran interface for the definition of points.
Definition yac_module.F90:1235
yac::yac_fenddef
Fortran interface for invoking the end of the definition phase.
Definition yac_module.F90:3738
yac::yac_ffinalize
Fortran interface for the coupler termination.
Definition yac_module.F90:461
yac::yac_ffree_interp_stack_config
Definition yac_module.F90:3520
yac::yac_fget_comp_comm
Fortran interface for getting back a local MPI communicator.
Definition yac_module.F90:3410
yac::yac_fget_interp_stack_config
Fortran interfaces for the definition of an interpolation stack.
Definition yac_module.F90:3516
yac::yac_fget
Fortran interface for receiving coupling fields.
Definition yac_module.F90:2232
yac::yac_finit
Definition yac_module.F90:267
yac::yac_fput
Fortran interface for sending coupling fields.
Definition yac_module.F90:1978
yac::yac_fread_config_yaml
Fortran interface for the reading of configuration files.
Definition yac_module.F90:324
yac::yac_fset_core_mask
Fortran interface for the setting of a grid core masks.
Definition yac_module.F90:1585
yac::yac_fset_global_index
Fortran interface for the setting of grid global ids.
Definition yac_module.F90:1551
yac::yac_fset_mask
Fortran interface for the setting of default pointset masks.
Definition yac_module.F90:1615
yac::yac_fsync_def
Fortran interface for invoking the end of the definition phase.
Definition yac_module.F90:3467
merge
static void merge(char *base_a, size_t num_a, int a_ascending, char *base_b, size_t num_b, int b_ascending, size_t size, int(*compar)(const void *, const void *), char *target)
Definition mergesort.c:56
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::yac_location_cell
@ yac_location_cell
Definition yac_module.F90:33
yac::yac_location_corner
@ yac_location_corner
Definition yac_module.F90:34
yac::yac_time_unit_second
@ yac_time_unit_second
Definition yac_module.F90:72
yac::yac_proleptic_gregorian
@ yac_proleptic_gregorian
Definition yac_module.F90:102
yac::yac_yaml_emitter_default_f
integer yac_yaml_emitter_default_f
Flag paramters for emitting of coupling configurations.
Definition yac_module.F90:206
yac::yac_reduction_time_none
@ yac_reduction_time_none
Definition yac_module.F90:88
yac_read_part_icon_grid_information
void yac_read_part_icon_grid_information(const char *filename, int *nbr_vertices, int *nbr_cells, int **num_vertices_per_cell, int **cell_to_vertex, double **x_vertices, double **y_vertices, double **x_cells, double **y_cells, int **global_cell_id, int **cell_mask, int **cell_core_mask, int **global_corner_id, int **corner_core_mask, int rank, int size)
Definition read_icon_grid.c:31
error_exit
subroutine error_exit()
Definition test_dummy_coupling9.F90:402
generate_icon_grid
subroutine generate_icon_grid(comm_rank, comm_size, grid_dir)
Definition test_restart_dble.F90:284
generate_cube_grid
subroutine generate_cube_grid(comm_rank, comm_size)
Definition test_restart_dble.F90:506